{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Node.Tracing.Tracers.ChainDB
   ( withAddedToCurrentChainEmptyLimited
   , fragmentChainDensity
   ) where

import           Cardano.Logging
import           Cardano.Node.Tracing.Era.Byron ()
import           Cardano.Node.Tracing.Era.Shelley ()
import           Cardano.Node.Tracing.Formatting ()
import           Cardano.Node.Tracing.Render
import           Cardano.Prelude (maximumDef)
import           Cardano.Tracing.HasIssuer
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HeaderValidation (HeaderEnvelopeError (..), HeaderError (..),
                   OtherHeaderEnvelopeError)
import           Ouroboros.Consensus.Ledger.Abstract (LedgerError)
import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError (..))
import           Ouroboros.Consensus.Ledger.Inspect (InspectLedger, LedgerEvent (..))
import           Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
import           Ouroboros.Consensus.Protocol.Abstract (SelectView, ValidationErr)
import qualified Ouroboros.Consensus.Protocol.PBFT as PBFT
import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmDB
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal (chunkNoToInt)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Types as ImmDB
import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.Snapshots as LedgerDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore as V1
import qualified Ouroboros.Consensus.Storage.LedgerDB.V2.Args as V2
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolDB
import           Ouroboros.Consensus.Util.Condense (condense)
import           Ouroboros.Consensus.Util.Enclose
import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.Block (MaxSlotNo (..))

import           Data.Aeson (Value (String), object, toJSON, (.=))
import qualified Data.ByteString.Base16 as B16
import           Data.Int (Int64)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Word (Word64)
import           Numeric (showFFloat)

-- {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}

-- A limiter that is not coming from configuration, because it carries a special filter
withAddedToCurrentChainEmptyLimited
  :: Trace IO (ChainDB.TraceEvent blk)
  -> IO (Trace IO (ChainDB.TraceEvent blk))
withAddedToCurrentChainEmptyLimited tr = do
  ltr <- limitFrequency 1.25 "AddedToCurrentChainLimiter" mempty tr
  pure $ routingTrace (selecting ltr) tr
 where
    selecting
      ltr
      (ChainDB.TraceAddBlockEvent (ChainDB.AddedToCurrentChain events _ _ _)) =
        if null events
          then pure ltr
          else pure tr
    selecting _ _ = pure tr


-- --------------------------------------------------------------------------------
-- -- ChainDB Tracer
-- --------------------------------------------------------------------------------

instance (  LogFormatting (Header blk)
          , LogFormatting (LedgerEvent blk)
          , LogFormatting (RealPoint blk)
          , LogFormatting (SelectView (BlockProtocol blk))
          , ConvertRawHash blk
          , ConvertRawHash (Header blk)
          , LedgerSupportsProtocol blk
          , InspectLedger blk
          , HasIssuer blk
          ) => LogFormatting (ChainDB.TraceEvent blk) where
  forHuman ChainDB.TraceLastShutdownUnclean        =
    "ChainDB is not clean. Validating all immutable chunks"
  forHuman (ChainDB.TraceAddBlockEvent v)          = forHuman v
  forHuman (ChainDB.TraceFollowerEvent v)          = forHuman v
  forHuman (ChainDB.TraceCopyToImmutableDBEvent v) = forHuman v
  forHuman (ChainDB.TraceGCEvent v)                = forHuman v
  forHuman (ChainDB.TraceInitChainSelEvent v)      = forHuman v
  forHuman (ChainDB.TraceOpenEvent v)              = forHuman v
  forHuman (ChainDB.TraceIteratorEvent v)          = forHuman v
  forHuman (ChainDB.TraceLedgerDBEvent v)          = forHuman v
  forHuman (ChainDB.TraceImmutableDBEvent v)       = forHuman v
  forHuman (ChainDB.TraceVolatileDBEvent v)        = forHuman v
  forHuman (ChainDB.TraceChainSelStarvationEvent ev) = case ev of
        ChainDB.ChainSelStarvation RisingEdge ->
          "Chain Selection was starved."
        ChainDB.ChainSelStarvation (FallingEdgeWith pt) ->
          "Chain Selection was unstarved by " <> renderRealPoint pt

  forMachine _ ChainDB.TraceLastShutdownUnclean =
    mconcat [ "kind" .= String "LastShutdownUnclean" ]
  forMachine dtal (ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation edge)) =
    mconcat [ "kind" .= String "ChainSelStarvation"
             , case edge of
                 RisingEdge -> "risingEdge" .= True
                 FallingEdgeWith pt -> "fallingEdge" .= forMachine dtal pt
             ]
  forMachine details (ChainDB.TraceAddBlockEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceFollowerEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceCopyToImmutableDBEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceGCEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceInitChainSelEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceOpenEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceIteratorEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceLedgerDBEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceImmutableDBEvent v) =
    forMachine details v
  forMachine details (ChainDB.TraceVolatileDBEvent v) =
    forMachine details v

  asMetrics ChainDB.TraceLastShutdownUnclean         = []
  asMetrics (ChainDB.TraceChainSelStarvationEvent _) = []
  asMetrics (ChainDB.TraceAddBlockEvent v)           = asMetrics v
  asMetrics (ChainDB.TraceFollowerEvent v)           = asMetrics v
  asMetrics (ChainDB.TraceCopyToImmutableDBEvent v)  = asMetrics v
  asMetrics (ChainDB.TraceGCEvent v)                 = asMetrics v
  asMetrics (ChainDB.TraceInitChainSelEvent v)       = asMetrics v
  asMetrics (ChainDB.TraceOpenEvent v)               = asMetrics v
  asMetrics (ChainDB.TraceIteratorEvent v)           = asMetrics v
  asMetrics (ChainDB.TraceLedgerDBEvent v)          = asMetrics v
  asMetrics (ChainDB.TraceImmutableDBEvent v)       = asMetrics v
  asMetrics (ChainDB.TraceVolatileDBEvent v)        = asMetrics v


instance MetaTrace  (ChainDB.TraceEvent blk) where
  namespaceFor ChainDB.TraceLastShutdownUnclean =
    Namespace [] ["LastShutdownUnclean"]
  namespaceFor ChainDB.TraceChainSelStarvationEvent{} =
    Namespace [] ["ChainSelStarvationEvent"]
  namespaceFor (ChainDB.TraceAddBlockEvent ev) =
    nsPrependInner "AddBlockEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceFollowerEvent ev) =
    nsPrependInner "FollowerEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceCopyToImmutableDBEvent ev) =
    nsPrependInner "CopyToImmutableDBEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceGCEvent ev) =
    nsPrependInner "GCEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceInitChainSelEvent ev) =
    nsPrependInner "InitChainSelEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceOpenEvent ev) =
    nsPrependInner "OpenEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceIteratorEvent ev) =
    nsPrependInner "IteratorEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceLedgerDBEvent ev) =
    nsPrependInner "LedgerEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceImmutableDBEvent ev) =
    nsPrependInner "ImmDbEvent" (namespaceFor ev)
  namespaceFor (ChainDB.TraceVolatileDBEvent ev) =
     nsPrependInner "VolatileDbEvent" (namespaceFor ev)

  severityFor (Namespace _ ["LastShutdownUnclean"]) _ = Just Info
  severityFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just Debug
  severityFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("AddBlockEvent" : tl)) Nothing =
    severityFor (Namespace out tl  :: Namespace (ChainDB.TraceAddBlockEvent blk)) Nothing
  severityFor (Namespace out ("FollowerEvent" : tl)) (Just (ChainDB.TraceFollowerEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("FollowerEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ChainDB.TraceFollowerEvent blk)) Nothing
  severityFor (Namespace out ("CopyToImmutableDBEvent" : tl)) (Just (ChainDB.TraceCopyToImmutableDBEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("CopyToImmutableDBEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)) Nothing
  severityFor (Namespace out ("GCEvent" : tl)) (Just (ChainDB.TraceGCEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("GCEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ChainDB.TraceGCEvent blk)) Nothing
  severityFor (Namespace out ("InitChainSelEvent" : tl)) (Just (ChainDB.TraceInitChainSelEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("InitChainSelEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ChainDB.TraceInitChainSelEvent blk)) Nothing
  severityFor (Namespace out ("OpenEvent" : tl)) (Just (ChainDB.TraceOpenEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("OpenEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ChainDB.TraceOpenEvent blk)) Nothing
  severityFor (Namespace out ("IteratorEvent" : tl)) (Just (ChainDB.TraceIteratorEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("IteratorEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Nothing
  severityFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceLedgerDBEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("LedgerEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk)) Nothing
  severityFor (Namespace out ("ImmDbEvent" : tl)) (Just (ChainDB.TraceImmutableDBEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("ImmDbEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk)) Nothing
  severityFor (Namespace out ("VolatileDbEvent" : tl)) (Just (ChainDB.TraceVolatileDBEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("VolatileDbEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk)) Nothing
  severityFor _ns _ = Nothing

  privacyFor (Namespace _ ["LastShutdownUnclean"]) _ = Just Public
  privacyFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just Public
  privacyFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("AddBlockEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceAddBlockEvent blk)) Nothing
  privacyFor (Namespace out ("FollowerEvent" : tl)) (Just (ChainDB.TraceFollowerEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("FollowerEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceFollowerEvent blk)) Nothing
  privacyFor (Namespace out ("CopyToImmutableDBEvent" : tl)) (Just (ChainDB.TraceCopyToImmutableDBEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("CopyToImmutableDBEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)) Nothing
  privacyFor (Namespace out ("GCEvent" : tl)) (Just (ChainDB.TraceGCEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("GCEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceGCEvent blk)) Nothing
  privacyFor (Namespace out ("InitChainSelEvent" : tl)) (Just (ChainDB.TraceInitChainSelEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("InitChainSelEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceInitChainSelEvent blk)) Nothing
  privacyFor (Namespace out ("OpenEvent" : tl)) (Just (ChainDB.TraceOpenEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("OpenEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceOpenEvent blk)) Nothing
  privacyFor (Namespace out ("IteratorEvent" : tl)) (Just (ChainDB.TraceIteratorEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("IteratorEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Nothing
  privacyFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceLedgerDBEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("LedgerEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk)) Nothing
  privacyFor (Namespace out ("ImmDbEvent" : tl)) (Just (ChainDB.TraceImmutableDBEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("ImmDbEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk)) Nothing
  privacyFor (Namespace out ("VolatileDbEvent" : tl)) (Just (ChainDB.TraceVolatileDBEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("VolatileDbEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk)) Nothing
  privacyFor _ _ = Nothing

  detailsFor (Namespace _ ["LastShutdownUnclean"]) _ = Just DNormal
  detailsFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just DNormal
  detailsFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("AddBlockEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceAddBlockEvent blk)) Nothing
  detailsFor (Namespace out ("FollowerEvent" : tl)) (Just (ChainDB.TraceFollowerEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("FollowerEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceFollowerEvent blk)) Nothing
  detailsFor (Namespace out ("CopyToImmutableDBEvent" : tl)) (Just (ChainDB.TraceCopyToImmutableDBEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("CopyToImmutableDBEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)) Nothing
  detailsFor (Namespace out ("GCEvent" : tl)) (Just (ChainDB.TraceGCEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("GCEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceGCEvent blk)) Nothing
  detailsFor (Namespace out ("InitChainSelEvent" : tl)) (Just (ChainDB.TraceInitChainSelEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("InitChainSelEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceInitChainSelEvent blk)) Nothing
  detailsFor (Namespace out ("OpenEvent" : tl)) (Just (ChainDB.TraceOpenEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("OpenEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceOpenEvent blk)) Nothing
  detailsFor (Namespace out ("IteratorEvent" : tl)) (Just (ChainDB.TraceIteratorEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("IteratorEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk)) Nothing
  detailsFor (Namespace out ("LedgerEvent" : tl)) (Just (ChainDB.TraceLedgerDBEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("LedgerEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk)) Nothing
  detailsFor (Namespace out ("ImmDbEvent" : tl)) (Just (ChainDB.TraceImmutableDBEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("ImmDbEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: (Namespace (ImmDB.TraceEvent blk))) Nothing
  detailsFor (Namespace out ("VolatileDbEvent" : tl)) (Just (ChainDB.TraceVolatileDBEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("VolatileDbEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: (Namespace (VolDB.TraceEvent blk))) Nothing
  detailsFor _ _ = Nothing

  metricsDocFor (Namespace out ("AddBlockEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceAddBlockEvent blk))
  metricsDocFor (Namespace out ("FollowerEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceFollowerEvent blk))
  metricsDocFor (Namespace out ("CopyToImmutableDBEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk))
  metricsDocFor (Namespace out ("GCEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceGCEvent blk))
  metricsDocFor (Namespace out ("InitChainSelEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceInitChainSelEvent blk))
  metricsDocFor (Namespace out ("OpenEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceOpenEvent blk))
  metricsDocFor (Namespace out ("IteratorEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk))
  metricsDocFor (Namespace out ("LedgerEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk))
  metricsDocFor (Namespace out ("ImmDbEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk))
  metricsDocFor (Namespace out ("VolatileDbEvent" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk))
  metricsDocFor _ = []

  documentFor (Namespace _ ["LastShutdownUnclean"]) = Just $ mconcat
    [ "Last shutdown of the node didn't leave the ChainDB directory in a clean"
    , " state. Therefore, revalidating all the immutable chunks is necessary to"
    , " ensure the correctness of the chain."
    ]
  documentFor (Namespace _ ["ChainSelStarvationEvent"]) = Just $ mconcat
    [ "ChainSel is waiting for a next block to process, but there is no block in the queue."
    , " Despite the name, it is a pretty normal (and frequent) event."
    ]
  documentFor (Namespace out ("AddBlockEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceAddBlockEvent blk))
  documentFor (Namespace out ("FollowerEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceFollowerEvent blk))
  documentFor (Namespace out ("CopyToImmutableDBEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceCopyToImmutableDBEvent blk))
  documentFor (Namespace out ("GCEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceGCEvent blk))
  documentFor (Namespace out ("InitChainSelEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceInitChainSelEvent blk))
  documentFor (Namespace out ("OpenEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceOpenEvent blk))
  documentFor (Namespace out ("IteratorEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceIteratorEvent blk))
  documentFor (Namespace out ("LedgerEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (LedgerDB.TraceEvent blk))
  documentFor (Namespace out ("ImmDbEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk))
  documentFor (Namespace out ("VolatileDbEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk))
  documentFor _ = Nothing

  allNamespaces =
        Namespace [] ["LastShutdownUnclean"]
          : Namespace [] ["ChainSelStarvationEvent"]
          : (map  (nsPrependInner "AddBlockEvent")
                  (allNamespaces :: [Namespace (ChainDB.TraceAddBlockEvent blk)])
          ++ map  (nsPrependInner "FollowerEvent")
                  (allNamespaces :: [Namespace (ChainDB.TraceFollowerEvent blk)])
          ++ map  (nsPrependInner "CopyToImmutableDBEvent")
                  (allNamespaces :: [Namespace (ChainDB.TraceCopyToImmutableDBEvent blk)])
          ++ map  (nsPrependInner "GCEvent")
                  (allNamespaces :: [Namespace (ChainDB.TraceGCEvent blk)])
          ++ map  (nsPrependInner "InitChainSelEvent")
                  (allNamespaces :: [Namespace (ChainDB.TraceInitChainSelEvent blk)])
          ++ map  (nsPrependInner "OpenEvent")
                  (allNamespaces :: [Namespace (ChainDB.TraceOpenEvent blk)])
          ++ map  (nsPrependInner "IteratorEvent")
                  (allNamespaces :: [Namespace (ChainDB.TraceIteratorEvent blk)])
          ++ map  (nsPrependInner "LedgerEvent")
                  (allNamespaces :: [Namespace (LedgerDB.TraceEvent blk)])
          ++ map  (nsPrependInner "ImmDbEvent")
                  (allNamespaces :: [Namespace (ImmDB.TraceEvent blk)])
          ++ map  (nsPrependInner "VolatileDbEvent")
                  (allNamespaces :: [Namespace (VolDB.TraceEvent blk)])
            )


--------------------------------------------------------------------------------
-- AddBlockEvent
--------------------------------------------------------------------------------


instance ( LogFormatting (Header blk)
         , LogFormatting (LedgerEvent blk)
         , LogFormatting (RealPoint blk)
         , LogFormatting (SelectView (BlockProtocol blk))
         , ConvertRawHash blk
         , ConvertRawHash (Header blk)
         , LedgerSupportsProtocol blk
         , InspectLedger blk
         , HasIssuer blk
         ) => LogFormatting (ChainDB.TraceAddBlockEvent blk) where
  forHuman (ChainDB.IgnoreBlockOlderThanImmTip pt) =
    "Ignoring block older than ImmTip: " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.IgnoreBlockAlreadyInVolatileDB pt) =
      "Ignoring block already in DB: " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.IgnoreInvalidBlock pt _reason) =
      "Ignoring previously seen invalid block: " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.AddedBlockToQueue pt edgeSz) =
      case edgeSz of
        RisingEdge ->
          "About to add block to queue: " <> renderRealPointAsPhrase pt
        FallingEdgeWith sz ->
          "Block added to queue: " <> renderRealPointAsPhrase pt <> ", queue size " <> condenseT sz
  forHuman ChainDB.PoppingFromQueue =
    "Popping block from queue"
  forHuman (ChainDB.PoppedBlockFromQueue pt) =
    "Popped block from queue: " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.StoreButDontChange pt) =
      "Ignoring block: " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.TryAddToCurrentChain pt) =
      "Block fits onto the current chain: " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.TrySwitchToAFork pt _) =
      "Block fits onto some fork: " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.ChangingSelection pt) =
      "Changing selection to: " <> renderPointAsPhrase pt
  forHuman (ChainDB.AddedToCurrentChain es _ _ c) =
      "Chain extended, new tip: " <> renderPointAsPhrase (AF.headPoint c) <>
        Text.concat [ "\nEvent: " <> showT e | e <- es ]
  forHuman (ChainDB.SwitchedToAFork es _ _ c) =
      "Switched to a fork, new tip: " <> renderPointAsPhrase (AF.headPoint c) <>
        Text.concat [ "\nEvent: " <> showT e | e <- es ]
  forHuman (ChainDB.AddBlockValidation ev') = forHuman ev'
  forHuman (ChainDB.AddedBlockToVolatileDB pt _ _ enclosing) =
      case enclosing of
        RisingEdge  -> "Chain about to add block " <> renderRealPointAsPhrase pt
        FallingEdge -> "Chain added block " <> renderRealPointAsPhrase pt
  forHuman (ChainDB.PipeliningEvent ev') = forHuman ev'
  forHuman (ChainDB.AddedReprocessLoEBlocksToQueue edgeSz) =
      case edgeSz of
        RisingEdge ->
          "About to add request to queue to reprocess blocks postponed by LoE."
        FallingEdgeWith sz ->
          "Added request to queue to reprocess blocks postponed by LoE" <> ", queue size " <> condenseT sz
  forHuman ChainDB.PoppedReprocessLoEBlocksFromQueue =
      "Poppped request from queue to reprocess blocks postponed by LoE."
  forHuman ChainDB.ChainSelectionLoEDebug{} =
      "ChainDB LoE debug event"
  forMachine dtal (ChainDB.IgnoreBlockOlderThanImmTip pt) =
      mconcat [ "kind" .= String "IgnoreBlockOlderThanImmTip"
               , "block" .= forMachine dtal pt ]
  forMachine dtal (ChainDB.IgnoreBlockAlreadyInVolatileDB pt) =
      mconcat [ "kind" .= String "IgnoreBlockAlreadyInVolatileDB"
               , "block" .= forMachine dtal pt ]
  forMachine dtal (ChainDB.IgnoreInvalidBlock pt reason) =
      mconcat [ "kind" .= String "IgnoreInvalidBlock"
               , "block" .= forMachine dtal pt
               , "reason" .= showT reason ]
  forMachine dtal (ChainDB.AddedBlockToQueue pt edgeSz) =
      mconcat [ "kind" .= String "AddedBlockToQueue"
               , "block" .= forMachine dtal pt
               , case edgeSz of
                   RisingEdge         -> "risingEdge" .= True
                   FallingEdgeWith sz -> "queueSize" .= toJSON sz ]
  forMachine _dtal ChainDB.PoppingFromQueue =
     mconcat [ "kind" .= String "PoppingFromQueue"
             ]
  forMachine dtal (ChainDB.PoppedBlockFromQueue pt) =
      mconcat [ "kind" .= String "TraceAddBlockEvent.PoppedBlockFromQueue"
              , "block" .= forMachine dtal pt ]
  forMachine dtal (ChainDB.StoreButDontChange pt) =
      mconcat [ "kind" .= String "StoreButDontChange"
               , "block" .= forMachine dtal pt ]
  forMachine dtal (ChainDB.TryAddToCurrentChain pt) =
      mconcat [ "kind" .= String "TryAddToCurrentChain"
               , "block" .= forMachine dtal pt ]
  forMachine dtal (ChainDB.TrySwitchToAFork pt _) =
      mconcat [ "kind" .= String "TraceAddBlockEvent.TrySwitchToAFork"
               , "block" .= forMachine dtal pt ]
  forMachine dtal (ChainDB.ChangingSelection pt) =
      mconcat [ "kind" .= String "TraceAddBlockEvent.ChangingSelection"
               , "block" .= forMachine dtal pt ]

  forMachine DDetailed (ChainDB.AddedToCurrentChain events selChangedInfo base extended) =
      let ChainInformation { .. } = chainInformation selChangedInfo base extended 0
          tipBlockIssuerVkHashText :: Text
          tipBlockIssuerVkHashText =
            case tipBlockIssuerVerificationKeyHash of
              NoBlockIssuer -> "NoBlockIssuer"
              BlockIssuerVerificationKeyHash bs ->
                Text.decodeLatin1 (B16.encode bs)
      in mconcat $
               [ "kind" .=  String "AddedToCurrentChain"
               , "newtip" .= renderPointForDetails DDetailed (AF.headPoint extended)
               , "newTipSelectView" .= forMachine DDetailed (ChainDB.newTipSelectView selChangedInfo)
               ]
            ++ [ "oldTipSelectView" .= forMachine DDetailed oldTipSelectView
               | Just oldTipSelectView <- [ChainDB.oldTipSelectView selChangedInfo]
               ]
            ++ [ "headers" .= toJSON (forMachine DDetailed `map` addedHdrsNewChain base extended)
               ]
            ++ [ "events" .= toJSON (map (forMachine DDetailed) events)
               | not (null events) ]
            ++ [ "tipBlockHash" .= tipBlockHash
               , "tipBlockParentHash" .= tipBlockParentHash
               , "tipBlockIssuerVKeyHash" .= tipBlockIssuerVkHashText]
  forMachine dtal (ChainDB.AddedToCurrentChain events selChangedInfo _base extended) =
      mconcat $
               [ "kind" .=  String "AddedToCurrentChain"
               , "newtip" .= renderPointForDetails dtal (AF.headPoint extended)
               , "newTipSelectView" .= forMachine dtal (ChainDB.newTipSelectView selChangedInfo)
               ]
            ++ [ "oldTipSelectView" .= forMachine dtal oldTipSelectView
               | Just oldTipSelectView <- [ChainDB.oldTipSelectView selChangedInfo]
               ]
            ++ [ "events" .= toJSON (map (forMachine dtal) events)
               | not (null events) ]

  forMachine DDetailed (ChainDB.SwitchedToAFork events selChangedInfo old new) =
      let ChainInformation { .. } = chainInformation selChangedInfo old new 0
          tipBlockIssuerVkHashText :: Text
          tipBlockIssuerVkHashText =
            case tipBlockIssuerVerificationKeyHash of
              NoBlockIssuer -> "NoBlockIssuer"
              BlockIssuerVerificationKeyHash bs ->
                Text.decodeLatin1 (B16.encode bs)
      in mconcat $
               [ "kind" .= String "TraceAddBlockEvent.SwitchedToAFork"
               , "newtip" .= renderPointForDetails DDetailed (AF.headPoint new)
               , "newTipSelectView" .= forMachine DDetailed (ChainDB.newTipSelectView selChangedInfo)
               ]
            ++ [ "oldTipSelectView" .= forMachine DDetailed oldTipSelectView
               | Just oldTipSelectView <- [ChainDB.oldTipSelectView selChangedInfo]
               ]
            ++ [ "headers" .= toJSON (forMachine DDetailed `map` addedHdrsNewChain old new)
               ]
            ++ [ "events" .= toJSON (map (forMachine DDetailed) events)
               | not (null events) ]
            ++ [ "tipBlockHash" .= tipBlockHash
               , "tipBlockParentHash" .= tipBlockParentHash
               , "tipBlockIssuerVKeyHash" .= tipBlockIssuerVkHashText]
  forMachine dtal (ChainDB.SwitchedToAFork events selChangedInfo _old new) =
      mconcat $
               [ "kind" .= String "TraceAddBlockEvent.SwitchedToAFork"
               , "newtip" .= renderPointForDetails dtal (AF.headPoint new)
               , "newTipSelectView" .= forMachine dtal (ChainDB.newTipSelectView selChangedInfo)
               ]
            ++ [ "oldTipSelectView" .= forMachine dtal oldTipSelectView
               | Just oldTipSelectView <- [ChainDB.oldTipSelectView selChangedInfo]
               ]
            ++ [ "events" .= toJSON (map (forMachine dtal) events)
               | not (null events) ]

  forMachine dtal (ChainDB.AddBlockValidation ev') =
    forMachine dtal ev'
  forMachine dtal (ChainDB.AddedBlockToVolatileDB pt (BlockNo bn) _ enclosing) =
      mconcat $ [ "kind" .= String "AddedBlockToVolatileDB"
                , "block" .= forMachine dtal pt
                , "blockNo" .= showT bn ]
                <> [ "risingEdge" .= True | RisingEdge <- [enclosing] ]
  forMachine dtal (ChainDB.PipeliningEvent ev') =
    forMachine dtal ev'
  forMachine _dtal (ChainDB.AddedReprocessLoEBlocksToQueue edgeSz) =
      mconcat [ "kind" .= String "AddedReprocessLoEBlocksToQueue"
               , case edgeSz of
                   RisingEdge         -> "risingEdge" .= True
                   FallingEdgeWith sz -> "queueSize" .= toJSON sz ]
  forMachine _dtal ChainDB.PoppedReprocessLoEBlocksFromQueue =
      mconcat [ "kind" .= String "PoppedReprocessLoEBlocksFromQueue" ]
  forMachine dtal (ChainDB.ChainSelectionLoEDebug curChain loeFrag) =
      case loeFrag of
        ChainDB.LoEEnabled loeF ->
          mconcat [ "kind" .= String "ChainSelectionLoEDebug"
                  , "curChain" .= headAndAnchor curChain
                  , "loeFrag" .= headAndAnchor loeF
                  ]
        ChainDB.LoEDisabled ->
          mconcat [ "kind" .= String "ChainSelectionLoEDebug"
                  , "curChain" .= headAndAnchor curChain
                  , "loeFrag" .= String "LoE is disabled"
                  ]
    where
      headAndAnchor frag = object
        [ "anchor" .= forMachine dtal (AF.anchorPoint frag)
        , "head" .= forMachine dtal (AF.headPoint frag)
        ]


  asMetrics (ChainDB.SwitchedToAFork _warnings selChangedInfo oldChain newChain) =
    let forkIt = not $ AF.withinFragmentBounds (AF.headPoint oldChain)
                              newChain
        ChainInformation { .. } = chainInformation selChangedInfo oldChain newChain 0
        tipBlockIssuerVkHashText =
          case tipBlockIssuerVerificationKeyHash of
            NoBlockIssuer -> "NoBlockIssuer"
            BlockIssuerVerificationKeyHash bs ->
              Text.decodeLatin1 (B16.encode bs)
    in  [ DoubleM "density" (fromRational density)
        , IntM    "slotNum" (fromIntegral slots)
        , IntM    "blockNum" (fromIntegral blocks)
        , IntM    "slotInEpoch" (fromIntegral slotInEpoch)
        , IntM    "epoch" (fromIntegral (unEpochNo epoch))
        , CounterM "forks" (Just (if forkIt then 1 else 0))
        , PrometheusM "tipBlock" [("hash",tipBlockHash)
                                 ,("parent_hash",tipBlockParentHash)
                                 ,("issuer_VKey_hash", tipBlockIssuerVkHashText)]
        ]
  asMetrics (ChainDB.AddedToCurrentChain _warnings selChangedInfo oldChain newChain) =
    let ChainInformation { .. } =
          chainInformation selChangedInfo oldChain newChain 0
        tipBlockIssuerVkHashText =
          case tipBlockIssuerVerificationKeyHash of
            NoBlockIssuer -> "NoBlockIssuer"
            BlockIssuerVerificationKeyHash bs ->
              Text.decodeLatin1 (B16.encode bs)
    in  [ DoubleM "density" (fromRational density)
        , IntM    "slotNum" (fromIntegral slots)
        , IntM    "blockNum" (fromIntegral blocks)
        , IntM    "slotInEpoch" (fromIntegral slotInEpoch)
        , IntM    "epoch" (fromIntegral (unEpochNo epoch))
        , PrometheusM "tipBlock" [("hash",tipBlockHash)
                                 ,("parent_hash",tipBlockParentHash)
                                 ,("issuer_verification_key_hash", tipBlockIssuerVkHashText)]
        ]
  asMetrics _ = []


instance MetaTrace  (ChainDB.TraceAddBlockEvent blk) where
  namespaceFor ChainDB.IgnoreBlockOlderThanImmTip {} =
    Namespace [] ["IgnoreBlockOlderThanImmTip"]
  namespaceFor ChainDB.IgnoreBlockAlreadyInVolatileDB {} =
    Namespace [] ["IgnoreBlockAlreadyInVolatileDB"]
  namespaceFor ChainDB.IgnoreInvalidBlock {} =
    Namespace [] ["IgnoreInvalidBlock"]
  namespaceFor ChainDB.AddedBlockToQueue {} =
    Namespace [] ["AddedBlockToQueue"]
  namespaceFor ChainDB.PoppingFromQueue {} =
    Namespace [] ["PoppingFromQueue"]
  namespaceFor ChainDB.PoppedBlockFromQueue {} =
    Namespace [] ["PoppedBlockFromQueue"]
  namespaceFor ChainDB.AddedBlockToVolatileDB {} =
    Namespace [] ["AddedBlockToVolatileDB"]
  namespaceFor ChainDB.TryAddToCurrentChain {} =
    Namespace [] ["TryAddToCurrentChain"]
  namespaceFor ChainDB.TrySwitchToAFork {} =
    Namespace [] ["TrySwitchToAFork"]
  namespaceFor ChainDB.StoreButDontChange {} =
    Namespace [] ["StoreButDontChange"]
  namespaceFor ChainDB.AddedToCurrentChain {} =
    Namespace [] ["AddedToCurrentChain"]
  namespaceFor ChainDB.SwitchedToAFork {} =
    Namespace [] ["SwitchedToAFork"]
  namespaceFor ChainDB.ChangingSelection {} =
    Namespace [] ["ChangingSelection"]
  namespaceFor (ChainDB.AddBlockValidation ev') =
    nsPrependInner "AddBlockValidation" (namespaceFor ev')
  namespaceFor (ChainDB.PipeliningEvent ev') =
    nsPrependInner "PipeliningEvent" (namespaceFor ev')
  namespaceFor ChainDB.AddedReprocessLoEBlocksToQueue {} =
    Namespace [] ["AddedReprocessLoEBlocksToQueue"]
  namespaceFor ChainDB.PoppedReprocessLoEBlocksFromQueue =
    Namespace [] ["PoppedReprocessLoEBlocksFromQueue"]
  namespaceFor ChainDB.ChainSelectionLoEDebug {} =
    Namespace [] ["ChainSelectionLoEDebug"]

  severityFor (Namespace _ ["IgnoreBlockOlderThanK"]) _ = Just Info
  severityFor (Namespace _ ["IgnoreBlockAlreadyInVolatileDB"]) _ = Just Info
  severityFor (Namespace _ ["IgnoreInvalidBlock"]) _ = Just Info
  severityFor (Namespace _ ["AddedBlockToQueue"]) _ = Just Debug
  severityFor (Namespace _ ["AddedBlockToVolatileDB"]) _ = Just Debug
  severityFor (Namespace _ ["PoppingFromQueue"]) _ = Just Debug
  severityFor (Namespace _ ["PoppedBlockFromQueue"]) _ = Just Debug
  severityFor (Namespace _ ["TryAddToCurrentChain"]) _ = Just Debug
  severityFor (Namespace _ ["TrySwitchToAFork"]) _ = Just Info
  severityFor (Namespace _ ["StoreButDontChange"]) _ = Just Debug
  severityFor (Namespace _ ["ChangingSelection"]) _ = Just Debug
  severityFor (Namespace _ ["AddedToCurrentChain"])
              (Just (ChainDB.AddedToCurrentChain events _ _ _)) =
    Just $ maximumDef Notice (map sevLedgerEvent events)
  severityFor (Namespace _ ["AddedToCurrentChain"]) Nothing = Just Notice
  severityFor (Namespace _ ["SwitchedToAFork"])
              (Just (ChainDB.SwitchedToAFork events _ _ _)) =
    Just $ maximumDef Notice (map sevLedgerEvent events)
  severityFor (Namespace _ ["SwitchedToAFork"]) _ =
    Just Notice
  severityFor (Namespace out ("AddBlockValidation" : tl))
              (Just (ChainDB.AddBlockValidation ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace _ ("AddBlockValidation" : _tl)) Nothing = Just Notice
  severityFor (Namespace out ("PipeliningEvent" : tl)) (Just (ChainDB.PipeliningEvent ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("PipeliningEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (ChainDB.TracePipeliningEvent blk)) Nothing
  severityFor (Namespace _ ["AddedReprocessLoEBlocksToQueue"]) _ = Just Debug
  severityFor (Namespace _ ["PoppedReprocessLoEBlocksFromQueue"]) _ = Just Debug
  severityFor (Namespace _ ["ChainSelectionLoEDebug"]) _ = Just Debug
  severityFor _ _ = Nothing

  privacyFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.AddBlockValidation ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("AddBlockEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk)) Nothing
  privacyFor (Namespace out ("PipeliningEvent" : tl)) (Just (ChainDB.PipeliningEvent ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("PipeliningEvent" : tl)) Nothing =
    privacyFor (Namespace out tl :: Namespace (ChainDB.TracePipeliningEvent blk)) Nothing
  privacyFor _ _ = Just Public

  detailsFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.AddBlockValidation ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("AddBlockEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk)) Nothing
  detailsFor (Namespace out ("PipeliningEvent" : tl)) (Just (ChainDB.PipeliningEvent ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("PipeliningEvent" : tl)) Nothing =
    detailsFor (Namespace out tl :: Namespace (ChainDB.TracePipeliningEvent blk)) Nothing
  detailsFor _ _ = Just DNormal

  metricsDocFor (Namespace _ ["SwitchedToAFork"]) =
        [ ( "density"
          , mconcat
            [ "The actual number of blocks created over the maximum expected number"
            , " of blocks that could be created over the span of the last @k@ blocks."
            ]
          )
        , ( "slotNum"
          , "Number of slots in this chain fragment."
          )
        , ( "blockNum"
          , "Number of blocks in this chain fragment."
          )
        , ( "slotInEpoch"
          , mconcat
            [ "Relative slot number of the tip of the current chain within the"
            , " epoch.."
            ]
          )
        , ( "epoch"
          , "In which epoch is the tip of the current chain."
          )
        , ( "forks"
          , "counter for forks"
          )
        , ( "tipBlock"
          , "Values for hash, parent hash and issuer verification key hash"
          )
        ]

  metricsDocFor (Namespace _ ["AddedToCurrentChain"]) =
        [ ( "density"
          , mconcat
            [ "The actual number of blocks created over the maximum expected number"
            , " of blocks that could be created over the span of the last @k@ blocks."
            ]
          )
        , ( "slotNum"
          , "Number of slots in this chain fragment."
          )
        , ( "blockNum"
          , "Number of blocks in this chain fragment."
          )
        , ( "slotInEpoch"
          , mconcat
            [ "Relative slot number of the tip of the current chain within the"
            , " epoch.."
            ]
          )
        , ( "epoch"
          , "In which epoch is the tip of the current chain."
          )
        , ( "tipBlock"
          , "Values for hash, parent hash and issuer verification key hash"
          )
        ]
  metricsDocFor _ = []

  documentFor (Namespace _ ["IgnoreBlockOlderThanK"]) = Just $ mconcat
    [ "A block with a 'BlockNo' more than @k@ back than the current tip"
    , " was ignored."
    ]
  documentFor (Namespace _ ["IgnoreBlockAlreadyInVolatileDB"]) = Just
    "A block that is already in the Volatile DB was ignored."
  documentFor (Namespace _ ["IgnoreInvalidBlock"]) = Just
    "A block that is invalid was ignored."
  documentFor (Namespace _ ["AddedBlockToQueue"]) = Just $ mconcat
    [ "The block was added to the queue and will be added to the ChainDB by"
    , " the background thread. The size of the queue is included.."
    ]
  documentFor (Namespace _ ["AddedBlockToVolatileDB"]) = Just
    "A block was added to the Volatile DB"
  documentFor (Namespace _ ["PoppingFromQueue"]) = Just ""
  documentFor (Namespace _ ["PoppedBlockFromQueue"]) = Just ""
  documentFor (Namespace _ ["TryAddToCurrentChain"]) = Just $ mconcat
    [ "The block fits onto the current chain, we'll try to use it to extend"
    , " our chain."
    ]
  documentFor (Namespace _ ["TrySwitchToAFork"]) = Just $ mconcat
    [ "The block fits onto some fork, we'll try to switch to that fork (if"
    , " it is preferable to our chain)"
    ]
  documentFor (Namespace _ ["StoreButDontChange"]) = Just $ mconcat
    [ "The block fits onto some fork, we'll try to switch to that fork (if"
    , " it is preferable to our chain)."
    ]
  documentFor (Namespace _ ["ChangingSelection"]) = Just $ mconcat
    [ "The new block fits onto the current chain (first"
    , " fragment) and we have successfully used it to extend our (new) current"
    , " chain (second fragment)."
    ]
  documentFor (Namespace _ ["AddedToCurrentChain"]) = Just $ mconcat
    [ "The new block fits onto the current chain (first"
    , " fragment) and we have successfully used it to extend our (new) current"
    , " chain (second fragment)."
    ]
  documentFor (Namespace _out ["SwitchedToAFork"]) = Just $ mconcat
    [ "The new block fits onto some fork and we have switched to that fork"
    , " (second fragment), as it is preferable to our (previous) current chain"
    , " (first fragment)."
    ]
  documentFor (Namespace out ("AddBlockValidation" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk))
  documentFor (Namespace out ("PipeliningEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace (ChainDB.TracePipeliningEvent blk))
  documentFor _ = Nothing


  allNamespaces =
    [ Namespace [] ["IgnoreBlockOlderThanK"]
    , Namespace [] ["IgnoreBlockAlreadyInVolatileDB"]
    , Namespace [] ["IgnoreInvalidBlock"]
    , Namespace [] ["AddedBlockToQueue"]
    , Namespace [] ["AddedBlockToVolatileDB"]
    , Namespace [] ["PoppingFromQueue"]
    , Namespace [] ["PoppedBlockFromQueue"]
    , Namespace [] ["TryAddToCurrentChain"]
    , Namespace [] ["TrySwitchToAFork"]
    , Namespace [] ["StoreButDontChange"]
    , Namespace [] ["ChangingSelection"]
    , Namespace [] ["AddedToCurrentChain"]
    , Namespace [] ["SwitchedToAFork"]
    , Namespace [] ["AddedReprocessLoEBlocksToQueue"]
    , Namespace [] ["PoppedReprocessLoEBlocksFromQueue"]
    , Namespace [] ["ChainSelectionLoEDebug"]
    ]
    ++ map (nsPrependInner "PipeliningEvent")
          (allNamespaces :: [Namespace (ChainDB.TracePipeliningEvent blk)])
    ++ map (nsPrependInner "AddBlockValidation")
          (allNamespaces :: [Namespace (ChainDB.TraceValidationEvent blk)])

--------------------------------------------------------------------------------
-- ChainDB TracePipeliningEvent
--------------------------------------------------------------------------------

instance ( ConvertRawHash (Header blk)
         , HasHeader (Header blk)
         ) => LogFormatting (ChainDB.TracePipeliningEvent blk) where
  forHuman (ChainDB.SetTentativeHeader hdr enclosing) =
      case enclosing of
        RisingEdge  -> "About to set tentative header to " <> renderPointAsPhrase (blockPoint hdr)
        FallingEdge -> "Set tentative header to " <> renderPointAsPhrase (blockPoint hdr)
  forHuman (ChainDB.TrapTentativeHeader hdr) =
      "Discovered trap tentative header " <> renderPointAsPhrase (blockPoint hdr)
  forHuman (ChainDB.OutdatedTentativeHeader hdr) =
      "Tentative header is now outdated " <> renderPointAsPhrase (blockPoint hdr)

  forMachine dtals (ChainDB.SetTentativeHeader hdr enclosing) =
      mconcat $ [ "kind" .= String "SetTentativeHeader"
                , "block" .= renderPointForDetails dtals (blockPoint hdr) ]
                <> [ "risingEdge" .= True | RisingEdge <- [enclosing] ]
  forMachine dtals (ChainDB.TrapTentativeHeader hdr) =
      mconcat [ "kind" .= String "TrapTentativeHeader"
               , "block" .= renderPointForDetails dtals (blockPoint hdr) ]
  forMachine dtals (ChainDB.OutdatedTentativeHeader hdr) =
      mconcat [ "kind" .= String "OutdatedTentativeHeader"
               , "block" .= renderPointForDetails dtals (blockPoint hdr)]

instance MetaTrace  (ChainDB.TracePipeliningEvent blk) where
  namespaceFor ChainDB.SetTentativeHeader {} =
    Namespace [] ["SetTentativeHeader"]
  namespaceFor ChainDB.TrapTentativeHeader {} =
    Namespace [] ["TrapTentativeHeader"]
  namespaceFor ChainDB.OutdatedTentativeHeader {} =
    Namespace [] ["OutdatedTentativeHeader"]

  severityFor (Namespace _ ["SetTentativeHeader"]) _ = Just Debug
  severityFor (Namespace _ ["TrapTentativeHeader"]) _ = Just Debug
  severityFor (Namespace _ ["OutdatedTentativeHeader"]) _ = Just Debug
  severityFor _ _ = Nothing

  documentFor (Namespace _ ["SetTentativeHeader"]) = Just
    "A new tentative header got set"
  documentFor (Namespace _ ["TrapTentativeHeader"]) = Just
    "The body of tentative block turned out to be invalid."
  documentFor (Namespace _ ["OutdatedTentativeHeader"]) = Just
    "We selected a new (better) chain, which cleared the previous tentative header."
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["SetTentativeHeader"]
    , Namespace [] ["TrapTentativeHeader"]
    , Namespace [] ["OutdatedTentativeHeader"]
    ]


addedHdrsNewChain :: HasHeader (Header blk)
  => AF.AnchoredFragment (Header blk)
  -> AF.AnchoredFragment (Header blk)
  -> [Header blk]
addedHdrsNewChain fro to_ =
 case AF.intersect fro to_ of
   Just (_, _, _, s2 :: AF.AnchoredFragment (Header blk)) ->
     AF.toOldestFirst s2
   Nothing -> [] -- No sense to do validation here.

--------------------------------------------------------------------------------
-- ChainDB TraceFollowerEvent
--------------------------------------------------------------------------------

instance (ConvertRawHash blk, StandardHash blk) =>
            LogFormatting (ChainDB.TraceFollowerEvent blk) where
  forHuman ChainDB.NewFollower = "A new Follower was created"
  forHuman (ChainDB.FollowerNoLongerInMem _rrs) = mconcat
    [ "The follower was in the 'FollowerInMem' state but its point is no longer on"
    , " the in-memory chain fragment, so it has to switch to the"
    , " 'FollowerInImmutableDB' state"
    ]
  forHuman (ChainDB.FollowerSwitchToMem point slot) = mconcat
    [ "The follower was in the 'FollowerInImmutableDB' state and is switched to"
    , " the 'FollowerInMem' state. Point: " <> showT point <> " slot: " <> showT slot
    ]
  forHuman (ChainDB.FollowerNewImmIterator point slot) = mconcat
    [ "The follower is in the 'FollowerInImmutableDB' state but the iterator is"
    , " exhausted while the ImmDB has grown, so we open a new iterator to"
    , " stream these blocks too. Point: " <> showT point <> " slot: " <> showT slot
    ]

  forMachine _dtal ChainDB.NewFollower =
      mconcat [ "kind" .= String "NewFollower" ]
  forMachine _dtal (ChainDB.FollowerNoLongerInMem _) =
      mconcat [ "kind" .= String "FollowerNoLongerInMem" ]
  forMachine _dtal (ChainDB.FollowerSwitchToMem _ _) =
      mconcat [ "kind" .= String "FollowerSwitchToMem" ]
  forMachine _dtal (ChainDB.FollowerNewImmIterator _ _) =
      mconcat [ "kind" .= String "FollowerNewImmIterator" ]

instance MetaTrace (ChainDB.TraceFollowerEvent blk) where
  namespaceFor ChainDB.NewFollower =
    Namespace [] ["NewFollower"]
  namespaceFor ChainDB.FollowerNoLongerInMem {} =
    Namespace [] ["FollowerNoLongerInMem"]
  namespaceFor ChainDB.FollowerSwitchToMem {} =
    Namespace [] ["FollowerSwitchToMem"]
  namespaceFor ChainDB.FollowerNewImmIterator {} =
    Namespace [] ["FollowerNewImmIterator"]

  severityFor (Namespace _ ["NewFollower"]) _ = Just Debug
  severityFor (Namespace _ ["FollowerNoLongerInMem"]) _ = Just Debug
  severityFor (Namespace _ ["FollowerSwitchToMem"]) _ = Just Debug
  severityFor (Namespace _ ["FollowerNewImmIterator"]) _ = Just Debug
  severityFor _ _ = Nothing

  documentFor (Namespace _ ["NewFollower"]) = Just
    "A new follower was created."
  documentFor (Namespace _ ["FollowerNoLongerInMem"]) = Just $ mconcat
    [ "The follower was in 'FollowerInMem' state and is switched to"
    , " the 'FollowerInImmutableDB' state."
    ]
  documentFor (Namespace _ ["FollowerSwitchToMem"]) = Just $ mconcat
    [ "The follower was in the 'FollowerInImmutableDB' state and is switched to"
    , " the 'FollowerInMem' state."
    ]
  documentFor (Namespace _ ["FollowerNewImmIterator"]) = Just $ mconcat
    [ "The follower is in the 'FollowerInImmutableDB' state but the iterator is"
    , " exhausted while the ImmDB has grown, so we open a new iterator to"
    , " stream these blocks too."
    ]
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["NewFollower"]
    , Namespace [] ["FollowerNoLongerInMem"]
    , Namespace [] ["FollowerSwitchToMem"]
    , Namespace [] ["FollowerNewImmIterator"]
    ]


--------------------------------------------------------------------------------
-- ChainDB TraceCopyToImmutableDB
--------------------------------------------------------------------------------

instance ConvertRawHash blk
          => LogFormatting (ChainDB.TraceCopyToImmutableDBEvent blk) where
  forHuman (ChainDB.CopiedBlockToImmutableDB pt) =
      "Copied block " <> renderPointAsPhrase pt <> " to the ImmDB"
  forHuman ChainDB.NoBlocksToCopyToImmutableDB  =
      "There are no blocks to copy to the ImmDB"

  forMachine dtals (ChainDB.CopiedBlockToImmutableDB pt) =
      mconcat [ "kind" .= String "CopiedBlockToImmutableDB"
               , "slot" .= forMachine dtals pt ]
  forMachine _dtals ChainDB.NoBlocksToCopyToImmutableDB =
      mconcat [ "kind" .= String "NoBlocksToCopyToImmutableDB" ]

instance MetaTrace (ChainDB.TraceCopyToImmutableDBEvent blk) where
  namespaceFor ChainDB.CopiedBlockToImmutableDB {} =
    Namespace [] ["CopiedBlockToImmutableDB"]
  namespaceFor ChainDB.NoBlocksToCopyToImmutableDB {} =
    Namespace [] ["NoBlocksToCopyToImmutableDB"]

  severityFor (Namespace _ ["CopiedBlockToImmutableDB"]) _ = Just Debug
  severityFor (Namespace _ ["NoBlocksToCopyToImmutableDB"]) _ = Just Debug
  severityFor _ _ = Nothing

  documentFor (Namespace _ ["CopiedBlockToImmutableDB"]) = Just
    "A block was successfully copied to the ImmDB."
  documentFor (Namespace _ ["NoBlocksToCopyToImmutableDB"]) = Just
     "There are no block to copy to the ImmDB."
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["CopiedBlockToImmutableDB"]
    , Namespace [] ["NoBlocksToCopyToImmutableDB"]
    ]

-- --------------------------------------------------------------------------------
-- -- ChainDB GCEvent
-- --------------------------------------------------------------------------------

instance LogFormatting (ChainDB.TraceGCEvent blk) where
  forHuman (ChainDB.PerformedGC slot) =
      "Performed a garbage collection for " <> condenseT slot
  forHuman (ChainDB.ScheduledGC slot _difft) =
      "Scheduled a garbage collection for " <> condenseT slot

  forMachine dtals (ChainDB.PerformedGC slot) =
      mconcat [ "kind" .= String "PerformedGC"
               , "slot" .= forMachine dtals slot ]
  forMachine dtals (ChainDB.ScheduledGC slot difft) =
      mconcat $ [ "kind" .= String "ScheduledGC"
                 , "slot" .= forMachine dtals slot ] <>
                 [ "difft" .= String ((Text.pack . show) difft) | dtals >= DDetailed]

instance MetaTrace (ChainDB.TraceGCEvent blk) where
  namespaceFor ChainDB.PerformedGC {} =
    Namespace [] ["PerformedGC"]
  namespaceFor ChainDB.ScheduledGC {} =
    Namespace [] ["ScheduledGC"]

  severityFor (Namespace _ ["PerformedGC"]) _ = Just Debug
  severityFor (Namespace _ ["ScheduledGC"]) _ = Just Debug
  severityFor _ _ = Nothing

  documentFor (Namespace _ ["PerformedGC"]) = Just
    "A garbage collection for the given 'SlotNo' was performed."
  documentFor (Namespace _ ["ScheduledGC"]) = Just $ mconcat
     [ "A garbage collection for the given 'SlotNo' was scheduled to happen"
     , " at the given time."
     ]
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["PerformedGC"]
    , Namespace [] ["ScheduledGC"]
    ]

-- --------------------------------------------------------------------------------
-- -- TraceInitChainSelEvent
-- --------------------------------------------------------------------------------

instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
  => LogFormatting (ChainDB.TraceInitChainSelEvent blk) where
    forHuman (ChainDB.InitChainSelValidation v) = forHuman v
    forHuman ChainDB.InitialChainSelected{} =
        "Initial chain selected"
    forHuman ChainDB.StartedInitChainSelection {} =
        "Started initial chain selection"

    forMachine dtal (ChainDB.InitChainSelValidation v) = forMachine dtal v
    forMachine _dtal ChainDB.InitialChainSelected =
      mconcat ["kind" .= String "Follower.InitialChainSelected"]
    forMachine _dtal ChainDB.StartedInitChainSelection =
      mconcat ["kind" .= String "Follower.StartedInitChainSelection"]

    asMetrics (ChainDB.InitChainSelValidation v) = asMetrics v
    asMetrics ChainDB.InitialChainSelected        = []
    asMetrics ChainDB.StartedInitChainSelection  = []

instance MetaTrace (ChainDB.TraceInitChainSelEvent blk) where
  namespaceFor ChainDB.InitialChainSelected {} =
    Namespace [] ["InitialChainSelected"]
  namespaceFor ChainDB.StartedInitChainSelection {} =
    Namespace [] ["StartedInitChainSelection"]
  namespaceFor (ChainDB.InitChainSelValidation ev') =
    nsPrependInner "Validation" (namespaceFor ev')

  severityFor (Namespace _ ["InitialChainSelected"]) _ = Just Info
  severityFor (Namespace _ ["StartedInitChainSelection"]) _ = Just Info
  severityFor (Namespace out ("Validation" : tl))
                            (Just (ChainDB.InitChainSelValidation ev')) =
    severityFor (Namespace out tl) (Just ev')
  severityFor (Namespace out ("Validation" : tl)) Nothing =
    severityFor (Namespace out tl ::
      Namespace (ChainDB.TraceValidationEvent blk)) Nothing
  severityFor _ _ = Nothing

  privacyFor (Namespace out ("Validation" : tl))
              (Just (ChainDB.InitChainSelValidation ev')) =
    privacyFor (Namespace out tl) (Just ev')
  privacyFor (Namespace out ("Validation" : tl)) Nothing =
    privacyFor (Namespace out tl ::
      Namespace (ChainDB.TraceValidationEvent blk)) Nothing
  privacyFor _ _ = Just Public

  detailsFor (Namespace out ("Validation" : tl))
              (Just (ChainDB.InitChainSelValidation ev')) =
    detailsFor (Namespace out tl) (Just ev')
  detailsFor (Namespace out ("Validation" : tl)) Nothing =
    detailsFor (Namespace out tl ::
      Namespace (ChainDB.TraceValidationEvent blk)) Nothing
  detailsFor _ _ = Just DNormal

  metricsDocFor (Namespace out ("Validation" : tl)) =
    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk))
  metricsDocFor _ = []

  documentFor (Namespace _ ["InitialChainSelected"]) = Just
    "A garbage collection for the given 'SlotNo' was performed."
  documentFor (Namespace _ ["StartedInitChainSelection"]) = Just $ mconcat
    [ "A garbage collection for the given 'SlotNo' was scheduled to happen"
    , " at the given time."
    ]
  documentFor (Namespace o ("Validation" : tl)) =
     documentFor (Namespace o tl :: Namespace (ChainDB.TraceValidationEvent blk))
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["InitialChainSelected"]
    , Namespace [] ["StartedInitChainSelection"]
    ]
    ++ map (nsPrependInner "Validation")
          (allNamespaces :: [Namespace (ChainDB.TraceValidationEvent blk)])



--------------------------------------------------------------------------------
-- ChainDB TraceValidationEvent
--------------------------------------------------------------------------------

instance ( LedgerSupportsProtocol blk
         , ConvertRawHash (Header blk)
         , ConvertRawHash blk
         , LogFormatting (RealPoint blk))
         => LogFormatting (ChainDB.TraceValidationEvent blk) where
    forHuman (ChainDB.InvalidBlock err pt) =
        "Invalid block " <> renderRealPointAsPhrase pt <> ": " <> showT err
    forHuman (ChainDB.ValidCandidate c) =
        "Valid candidate " <> renderPointAsPhrase (AF.headPoint c)
    forHuman (ChainDB.UpdateLedgerDbTraceEvent
                (LedgerDB.StartedPushingBlockToTheLedgerDb
                  (LedgerDB.PushStart start)
                  (LedgerDB.PushGoal goal)
                  (LedgerDB.Pushing curr))) =
            let fromSlot = unSlotNo $ realPointSlot start
                atSlot   = unSlotNo $ realPointSlot curr
                atDiff   = atSlot - fromSlot
                toSlot   = unSlotNo $ realPointSlot goal
                toDiff   = toSlot - fromSlot
            in
              "Pushing ledger state for block " <> renderRealPointAsPhrase curr <> ". Progress: " <>
              showProgressT (fromIntegral atDiff) (fromIntegral toDiff) <> "%"

    forMachine dtal  (ChainDB.InvalidBlock err pt) =
            mconcat [ "kind" .= String "InvalidBlock"
                     , "block" .= forMachine dtal pt
                     , "error" .= showT err ]
    forMachine dtal  (ChainDB.ValidCandidate c) =
            mconcat [ "kind" .= String "ValidCandidate"
                     , "block" .= renderPointForDetails dtal (AF.headPoint c) ]
    forMachine _dtal (ChainDB.UpdateLedgerDbTraceEvent
                        (LedgerDB.StartedPushingBlockToTheLedgerDb
                          (LedgerDB.PushStart start)
                          (LedgerDB.PushGoal goal)
                          (LedgerDB.Pushing curr))) =
            mconcat [ "kind" .= String "UpdateLedgerDbTraceEvent.StartedPushingBlockToTheLedgerDb"
                     , "startingBlock" .= renderRealPoint start
                     , "currentBlock" .= renderRealPoint curr
                     , "targetBlock" .= renderRealPoint goal
                     ]

instance MetaTrace (ChainDB.TraceValidationEvent blk) where
    namespaceFor ChainDB.ValidCandidate {} =
      Namespace [] ["ValidCandidate"]
    namespaceFor ChainDB.InvalidBlock {} =
      Namespace [] ["InvalidBlock"]
    namespaceFor ChainDB.UpdateLedgerDbTraceEvent {} =
      Namespace [] ["UpdateLedgerDb"]

    severityFor (Namespace _ ["ValidCandidate"]) _ = Just Info
    severityFor (Namespace _ ["InvalidBlock"]) _ = Just Error
    severityFor (Namespace _ ["UpdateLedgerDb"]) _ = Just Debug
    severityFor _ _ = Nothing

    documentFor (Namespace _ ["ValidCandidate"]) = Just $ mconcat
        [ "An event traced during validating performed while adding a block."
        , " A candidate chain was valid."
        ]
    documentFor (Namespace _ ["InvalidBlock"]) = Just $ mconcat
        [ "An event traced during validating performed while adding a block."
        , " A point was found to be invalid."
        ]
    documentFor (Namespace _ ["UpdateLedgerDb"]) = Just ""
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["ValidCandidate"]
      , Namespace [] ["InvalidBlock"]
      , Namespace [] ["UpdateLedgerDb"]
      ]

--------------------------------------------------------------------------------
-- TraceOpenEvent
--------------------------------------------------------------------------------

instance ConvertRawHash blk
          => LogFormatting (ChainDB.TraceOpenEvent blk) where
  forHuman (ChainDB.OpenedDB immTip tip') =
          "Opened db with immutable tip at " <> renderPointAsPhrase immTip <>
          " and tip " <> renderPointAsPhrase tip'
  forHuman (ChainDB.ClosedDB immTip tip') =
          "Closed db with immutable tip at " <> renderPointAsPhrase immTip <>
          " and tip " <> renderPointAsPhrase tip'
  forHuman (ChainDB.OpenedImmutableDB immTip chunk) =
          "Opened imm db with immutable tip at " <> renderPointAsPhrase immTip <>
          " and chunk " <> showT chunk
  forHuman (ChainDB.OpenedVolatileDB mx) = "Opened " <> case mx of
          NoMaxSlotNo -> "empty Volatile DB"
          MaxSlotNo mxx -> "Volatile DB with max slot seen " <> showT mxx
  forHuman ChainDB.OpenedLgrDB = "Opened lgr db"
  forHuman ChainDB.StartedOpeningDB = "Started opening Chain DB"
  forHuman ChainDB.StartedOpeningImmutableDB = "Started opening Immutable DB"
  forHuman ChainDB.StartedOpeningVolatileDB = "Started opening Volatile DB"
  forHuman ChainDB.StartedOpeningLgrDB = "Started opening Ledger DB"

  forMachine dtal (ChainDB.OpenedDB immTip tip')=
    mconcat [ "kind" .= String "OpenedDB"
             , "immtip" .= forMachine dtal immTip
             , "tip" .= forMachine dtal tip' ]
  forMachine dtal (ChainDB.ClosedDB immTip tip') =
    mconcat [ "kind" .= String "TraceOpenEvent.ClosedDB"
             , "immtip" .= forMachine dtal immTip
             , "tip" .= forMachine dtal tip' ]
  forMachine dtal (ChainDB.OpenedImmutableDB immTip epoch) =
    mconcat [ "kind" .= String "OpenedImmutableDB"
             , "immtip" .= forMachine dtal immTip
             , "epoch" .= String ((Text.pack . show) epoch) ]
  forMachine _dtal (ChainDB.OpenedVolatileDB maxSlotN) =
      mconcat [ "kind" .= String "OpenedVolatileDB"
               , "maxSlotNo" .= String (showT maxSlotN) ]
  forMachine _dtal ChainDB.OpenedLgrDB =
      mconcat [ "kind" .= String "OpenedLgrDB" ]
  forMachine _dtal ChainDB.StartedOpeningDB =
      mconcat ["kind" .= String "StartedOpeningDB"]
  forMachine _dtal ChainDB.StartedOpeningImmutableDB =
      mconcat ["kind" .= String "StartedOpeningImmutableDB"]
  forMachine _dtal ChainDB.StartedOpeningVolatileDB =
      mconcat ["kind" .= String "StartedOpeningVolatileDB"]
  forMachine _dtal ChainDB.StartedOpeningLgrDB =
      mconcat ["kind" .= String "StartedOpeningLgrDB"]

instance MetaTrace (ChainDB.TraceOpenEvent blk) where
    namespaceFor ChainDB.OpenedDB {} =
      Namespace [] ["OpenedDB"]
    namespaceFor ChainDB.ClosedDB {} =
      Namespace [] ["ClosedDB"]
    namespaceFor ChainDB.OpenedImmutableDB {} =
      Namespace [] ["OpenedImmutableDB"]
    namespaceFor ChainDB.OpenedVolatileDB {} =
      Namespace [] ["OpenedVolatileDB"]
    namespaceFor ChainDB.OpenedLgrDB {} =
      Namespace [] ["OpenedLgrDB"]
    namespaceFor ChainDB.StartedOpeningDB {} =
      Namespace [] ["StartedOpeningDB"]
    namespaceFor ChainDB.StartedOpeningImmutableDB {} =
      Namespace [] ["StartedOpeningImmutableDB"]
    namespaceFor ChainDB.StartedOpeningVolatileDB {} =
      Namespace [] ["StartedOpeningVolatileDB"]
    namespaceFor ChainDB.StartedOpeningLgrDB {} =
      Namespace [] ["StartedOpeningLgrDB"]

    severityFor (Namespace _ ["OpenedDB"]) _ = Just Info
    severityFor (Namespace _ ["ClosedDB"]) _ = Just Info
    severityFor (Namespace _ ["OpenedImmutableDB"]) _ = Just Info
    severityFor (Namespace _ ["OpenedVolatileDB"]) _ = Just Info
    severityFor (Namespace _ ["OpenedLgrDB"]) _ = Just Info
    severityFor (Namespace _ ["StartedOpeningDB"]) _ = Just Info
    severityFor (Namespace _ ["StartedOpeningImmutableDB"]) _ = Just Info
    severityFor (Namespace _ ["StartedOpeningVolatileDB"]) _ = Just Info
    severityFor (Namespace _ ["StartedOpeningLgrDB"]) _ = Just Info
    severityFor _ _ = Nothing

    documentFor (Namespace _ ["OpenedDB"]) = Just
      "The ChainDB was opened."
    documentFor (Namespace _ ["ClosedDB"]) = Just
      "The ChainDB was closed."
    documentFor (Namespace _ ["OpenedImmutableDB"]) = Just
      "The ImmDB was opened."
    documentFor (Namespace _ ["OpenedVolatileDB"]) = Just
      "The VolatileDB was opened."
    documentFor (Namespace _ ["OpenedLgrDB"]) = Just
      "The LedgerDB was opened."
    documentFor (Namespace _ ["StartedOpeningDB"]) = Just
      "The ChainDB is being opened."
    documentFor (Namespace _ ["StartedOpeningImmutableDB"]) = Just
      "The ImmDB is being opened."
    documentFor (Namespace _ ["StartedOpeningVolatileDB"]) = Just
      "The VolatileDB is being opened."
    documentFor (Namespace _ ["StartedOpeningLgrDB"]) = Just
      "The LedgerDB is being opened."
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["OpenedDB"]
      , Namespace [] ["ClosedDB"]
      , Namespace [] ["OpenedImmutableDB"]
      , Namespace [] ["OpenedVolatileDB"]
      , Namespace [] ["OpenedLgrDB"]
      , Namespace [] ["StartedOpeningDB"]
      , Namespace [] ["StartedOpeningImmutableDB"]
      , Namespace [] ["StartedOpeningVolatileDB"]
      , Namespace [] ["StartedOpeningLgrDB"]
      ]

--------------------------------------------------------------------------------
-- IteratorEvent
--------------------------------------------------------------------------------

instance  ( StandardHash blk
          , ConvertRawHash blk
          ) => LogFormatting (ChainDB.TraceIteratorEvent blk) where
  forHuman (ChainDB.UnknownRangeRequested ev') = forHuman ev'
  forHuman (ChainDB.BlockMissingFromVolatileDB realPt) = mconcat
    [ "This block is no longer in the VolatileDB because it has been garbage"
    , " collected. It might now be in the ImmDB if it was part of the"
    , " current chain. Block: " <> renderRealPoint realPt
    ]
  forHuman (ChainDB.StreamFromImmutableDB sFrom sTo) = mconcat
    [ "Stream only from the ImmDB. StreamFrom:" <> showT sFrom
    , " StreamTo: " <> showT sTo
    ]
  forHuman (ChainDB.StreamFromBoth sFrom sTo pts) = mconcat
    [ "Stream from both the VolatileDB and the ImmDB."
    , " StreamFrom: " <> showT sFrom <> " StreamTo: " <> showT sTo
    , " Points: " <> showT (map renderRealPoint pts)
    ]
  forHuman (ChainDB.StreamFromVolatileDB sFrom sTo pts) = mconcat
    [ "Stream only from the VolatileDB."
    , " StreamFrom: " <> showT sFrom <> " StreamTo: " <> showT sTo
    , " Points: " <> showT (map renderRealPoint pts)
    ]
  forHuman (ChainDB.BlockWasCopiedToImmutableDB pt) = mconcat
    [ "This block has been garbage collected from the VolatileDB is now"
    , " found and streamed from the ImmDB. Block: " <> renderRealPoint pt
    ]
  forHuman (ChainDB.BlockGCedFromVolatileDB pt) = mconcat
    [ "This block no longer in the VolatileDB and isn't in the ImmDB"
    , " either; it wasn't part of the current chain. Block: " <> renderRealPoint pt
    ]
  forHuman ChainDB.SwitchBackToVolatileDB = "SwitchBackToVolatileDB"

  forMachine _dtal (ChainDB.UnknownRangeRequested unkRange) =
    mconcat [ "kind" .= String "UnknownRangeRequested"
             , "range" .= String (showT unkRange)
             ]
  forMachine _dtal (ChainDB.StreamFromVolatileDB streamFrom streamTo realPt) =
    mconcat [ "kind" .= String "StreamFromVolatileDB"
             , "from" .= String (showT streamFrom)
             , "to" .= String (showT streamTo)
             , "point" .= String (Text.pack . show $ map renderRealPoint realPt)
             ]
  forMachine _dtal (ChainDB.StreamFromImmutableDB streamFrom streamTo) =
    mconcat [ "kind" .= String "StreamFromImmutableDB"
             , "from" .= String (showT streamFrom)
             , "to" .= String (showT streamTo)
             ]
  forMachine _dtal (ChainDB.StreamFromBoth streamFrom streamTo realPt) =
    mconcat [ "kind" .= String "StreamFromBoth"
             , "from" .= String (showT streamFrom)
             , "to" .= String (showT streamTo)
             , "point" .= String (Text.pack . show $ map renderRealPoint realPt)
             ]
  forMachine _dtal (ChainDB.BlockMissingFromVolatileDB realPt) =
    mconcat [ "kind" .= String "BlockMissingFromVolatileDB"
             , "point" .= String (renderRealPoint realPt)
             ]
  forMachine _dtal (ChainDB.BlockWasCopiedToImmutableDB realPt) =
    mconcat [ "kind" .= String "BlockWasCopiedToImmutableDB"
             , "point" .= String (renderRealPoint realPt)
             ]
  forMachine _dtal (ChainDB.BlockGCedFromVolatileDB realPt) =
    mconcat [ "kind" .= String "BlockGCedFromVolatileDB"
             , "point" .= String (renderRealPoint realPt)
             ]
  forMachine _dtal ChainDB.SwitchBackToVolatileDB =
    mconcat ["kind" .= String "SwitchBackToVolatileDB"
             ]

instance MetaTrace (ChainDB.TraceIteratorEvent blk) where
    namespaceFor (ChainDB.UnknownRangeRequested ur) =
      nsPrependInner "UnknownRangeRequested" (namespaceFor ur)
    namespaceFor ChainDB.StreamFromVolatileDB {} =
      Namespace [] ["StreamFromVolatileDB"]
    namespaceFor ChainDB.StreamFromImmutableDB {} =
      Namespace [] ["StreamFromImmutableDB"]
    namespaceFor ChainDB.StreamFromBoth {} =
      Namespace [] ["StreamFromBoth"]
    namespaceFor ChainDB.BlockMissingFromVolatileDB {} =
      Namespace [] ["BlockMissingFromVolatileDB"]
    namespaceFor ChainDB.BlockWasCopiedToImmutableDB {} =
      Namespace [] ["BlockWasCopiedToImmutableDB"]
    namespaceFor ChainDB.BlockGCedFromVolatileDB {} =
      Namespace [] ["BlockGCedFromVolatileDB"]
    namespaceFor ChainDB.SwitchBackToVolatileDB {} =
      Namespace [] ["SwitchBackToVolatileDB"]


    severityFor (Namespace out ("UnknownRangeRequested" : tl))
                (Just (ChainDB.UnknownRangeRequested ur)) =
      severityFor (Namespace out tl) (Just ur)
    severityFor (Namespace out ("UnknownRangeRequested" : tl)) Nothing =
      severityFor (Namespace out tl :: Namespace (ChainDB.UnknownRange blk)) Nothing
    severityFor _ _ = Just Debug

    privacyFor (Namespace out ("UnknownRangeRequested" : tl))
                (Just (ChainDB.UnknownRangeRequested ev')) =
      privacyFor (Namespace out tl) (Just ev')
    privacyFor (Namespace out ("UnknownRangeRequested" : tl)) Nothing =
      privacyFor (Namespace out tl ::
        Namespace (ChainDB.UnknownRange blk)) Nothing
    privacyFor _ _ = Just Public

    detailsFor (Namespace out ("UnknownRangeRequested" : tl))
                (Just (ChainDB.UnknownRangeRequested ev')) =
      detailsFor (Namespace out tl) (Just ev')
    detailsFor (Namespace out ("UnknownRangeRequested" : tl)) Nothing =
      detailsFor (Namespace out tl ::
        Namespace (ChainDB.UnknownRange blk)) Nothing
    detailsFor _ _ = Just DNormal

    documentFor (Namespace out ("UnknownRangeRequested" : tl)) =
      documentFor (Namespace out tl :: Namespace (ChainDB.UnknownRange blk))
    documentFor (Namespace _ ["StreamFromVolatileDB"]) = Just
       "Stream only from the VolatileDB."
    documentFor (Namespace _ ["StreamFromImmutableDB"]) = Just
      "Stream only from the ImmDB."
    documentFor (Namespace _ ["StreamFromBoth"]) = Just
      "Stream from both the VolatileDB and the ImmDB."
    documentFor (Namespace _ ["BlockMissingFromVolatileDB"]) = Just $ mconcat
      [ "A block is no longer in the VolatileDB because it has been garbage"
      , " collected. It might now be in the ImmDB if it was part of the"
      , " current chain."
      ]
    documentFor (Namespace _ ["BlockWasCopiedToImmutableDB"]) = Just $ mconcat
      [ "A block that has been garbage collected from the VolatileDB is now"
      , " found and streamed from the ImmDB."
      ]
    documentFor (Namespace _ ["BlockGCedFromVolatileDB"]) = Just $ mconcat
      [ "A block is no longer in the VolatileDB and isn't in the ImmDB"
      , " either; it wasn't part of the current chain."
      ]
    documentFor (Namespace _ ["SwitchBackToVolatileDB"]) = Just $ mconcat
      [ "We have streamed one or more blocks from the ImmDB that were part"
      , " of the VolatileDB when initialising the iterator. Now, we have to look"
      , " back in the VolatileDB again because the ImmDB doesn't have the"
      , " next block we're looking for."
      ]
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["StreamFromVolatileDB"]
      , Namespace [] ["StreamFromImmutableDB"]
      , Namespace [] ["StreamFromBoth"]
      , Namespace [] ["BlockMissingFromVolatileDB"]
      , Namespace [] ["BlockWasCopiedToImmutableDB"]
      , Namespace [] ["BlockGCedFromVolatileDB"]
      , Namespace [] ["SwitchBackToVolatileDB"]
      ]
      ++ map  (nsPrependInner "UnknownRangeRequested")
              (allNamespaces :: [Namespace (ChainDB.UnknownRange blk)])

--------------------------------------------------------------------------------
-- UnknownRange
--------------------------------------------------------------------------------

instance  ( StandardHash blk
          , ConvertRawHash blk
          ) => LogFormatting (ChainDB.UnknownRange blk) where
  forHuman (ChainDB.MissingBlock realPt) =
      "The block at the given point was not found in the ChainDB."
        <> renderRealPoint realPt
  forHuman (ChainDB.ForkTooOld streamFrom) =
      "The requested range forks off too far in the past"
        <> showT streamFrom

  forMachine _dtal (ChainDB.MissingBlock realPt) =
    mconcat [ "kind"  .= String "MissingBlock"
             , "point" .= String (renderRealPoint realPt)
             ]
  forMachine _dtal (ChainDB.ForkTooOld streamFrom) =
    mconcat [ "kind" .= String "ForkTooOld"
             , "from" .= String (showT streamFrom)
             ]

instance MetaTrace (ChainDB.UnknownRange blk) where
    namespaceFor ChainDB.MissingBlock {} = Namespace [] ["MissingBlock"]
    namespaceFor ChainDB.ForkTooOld {} = Namespace []  ["ForkTooOld"]

    severityFor _ _ = Just Debug

    documentFor (Namespace _ ["MissingBlock"]) = Just
      ""
    documentFor (Namespace _ ["ForkTooOld"]) = Just
      ""
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["MissingBlock"]
      , Namespace [] ["ForkTooOld"]
      ]

-- --------------------------------------------------------------------------------
-- -- LedgerDB.TraceEvent
-- --------------------------------------------------------------------------------

instance ( StandardHash blk
         , ConvertRawHash blk)
         => LogFormatting (LedgerDB.TraceEvent blk) where

  forMachine dtals (LedgerDB.LedgerDBSnapshotEvent ev) = forMachine dtals ev
  forMachine dtals (LedgerDB.LedgerReplayEvent ev) = forMachine dtals ev
  forMachine dtals (LedgerDB.LedgerDBForkerEvent ev) = forMachine dtals ev
  forMachine dtals (LedgerDB.LedgerDBFlavorImplEvent ev) = forMachine dtals ev

  forHuman (LedgerDB.LedgerDBSnapshotEvent ev) = forHuman ev
  forHuman (LedgerDB.LedgerReplayEvent ev) = forHuman ev
  forHuman (LedgerDB.LedgerDBForkerEvent ev) = forHuman ev
  forHuman (LedgerDB.LedgerDBFlavorImplEvent ev) = forHuman ev

instance MetaTrace (LedgerDB.TraceEvent blk) where

  namespaceFor (LedgerDB.LedgerDBSnapshotEvent ev) =
    nsPrependInner "Snapshot" (namespaceFor ev)
  namespaceFor (LedgerDB.LedgerReplayEvent ev) =
    nsPrependInner "Replay" (namespaceFor ev)
  namespaceFor (LedgerDB.LedgerDBForkerEvent ev) =
    nsPrependInner "Forker" (namespaceFor ev)
  namespaceFor (LedgerDB.LedgerDBFlavorImplEvent ev) =
    nsPrependInner "Flavor" (namespaceFor ev)

  severityFor (Namespace out ("Snapshot" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) Nothing
  severityFor (Namespace out ("Snapshot" : tl)) (Just (LedgerDB.LedgerDBSnapshotEvent ev)) =
    severityFor (Namespace out tl :: Namespace (LedgerDB.TraceSnapshotEvent blk)) (Just ev)
  severityFor (Namespace out ("Replay" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayEvent blk)) Nothing
  severityFor (Namespace out ("Replay" : tl)) (Just (LedgerDB.LedgerReplayEvent ev)) =
    severityFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayEvent blk)) (Just ev)
  severityFor (Namespace out ("Forker" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace LedgerDB.TraceForkerEventWithKey) Nothing
  severityFor (Namespace out ("Forker" : tl)) (Just (LedgerDB.LedgerDBForkerEvent ev)) =
    severityFor (Namespace out tl :: Namespace LedgerDB.TraceForkerEventWithKey) (Just ev)
  severityFor (Namespace out ("Flavor" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace LedgerDB.FlavorImplSpecificTrace) Nothing
  severityFor (Namespace out ("Flavor" : tl)) (Just (LedgerDB.LedgerDBFlavorImplEvent ev)) =
    severityFor (Namespace out tl :: Namespace LedgerDB.FlavorImplSpecificTrace) (Just ev)
  severityFor _ _ = Nothing

  documentFor (Namespace o ("Snapshot" : tl)) =
    documentFor (Namespace o tl :: Namespace (LedgerDB.TraceSnapshotEvent blk))
  documentFor (Namespace o ("Replay" : tl)) =
    documentFor (Namespace o tl :: Namespace (LedgerDB.TraceReplayEvent blk))
  documentFor (Namespace o ("Forker" : tl)) =
    documentFor (Namespace o tl :: Namespace LedgerDB.TraceForkerEventWithKey)
  documentFor (Namespace o ("Flavor" : tl)) =
    documentFor (Namespace o tl :: Namespace LedgerDB.FlavorImplSpecificTrace)
  documentFor _ = Nothing

  allNamespaces =
       map (nsPrependInner "Snapshot")
         (allNamespaces :: [Namespace (LedgerDB.TraceSnapshotEvent blk)])
    ++ map (nsPrependInner "Replay")
         (allNamespaces :: [Namespace (LedgerDB.TraceReplayEvent blk)])
    ++ map (nsPrependInner "Forker")
         (allNamespaces :: [Namespace LedgerDB.TraceForkerEventWithKey])
    ++ map (nsPrependInner "Flavor")
         (allNamespaces :: [Namespace LedgerDB.FlavorImplSpecificTrace])

instance ( StandardHash blk
         , ConvertRawHash blk)
         => LogFormatting (LedgerDB.TraceSnapshotEvent blk) where
  forHuman (LedgerDB.TookSnapshot snap pt RisingEdge) =
    Text.unwords [ "Taking ledger snapshot"
                 , showT snap
                 , "at"
                 , renderRealPointAsPhrase pt
                 ]
  forHuman (LedgerDB.TookSnapshot snap pt (FallingEdgeWith t)) =
    Text.unwords [ "Took ledger snapshot"
                 , showT snap
                 , "at"
                 , renderRealPointAsPhrase pt
                 , ", duration:"
                 , showT t
                 ]
  forHuman (LedgerDB.DeletedSnapshot snap) =
    Text.unwords ["Deleted old snapshot", showT snap]
  forHuman (LedgerDB.InvalidSnapshot snap failure) =
    Text.unwords [ "Invalid snapshot"
                 , showT snap
                 , showT failure
                 , context
                 ]
    where
      context = case failure of
        LedgerDB.InitFailureRead LedgerDB.ReadSnapshotFailed{} ->
             " This is most likely an expected change in the serialization format,"
          <> " which currently requires a chain replay"
        LedgerDB.InitFailureRead LedgerDB.ReadSnapshotDataCorruption ->
             " The snapshot fails the CRC check. It seems there has been disk corruption"
        LedgerDB.InitFailureRead (LedgerDB.ReadMetadataError _ err) -> case err of
          LedgerDB.MetadataFileDoesNotExist ->
             " The snapshot doesn't have the required metadata file."
          LedgerDB.MetadataInvalid errMsg ->
             " Snapshot metadata file failed to deserialize: " <> showT errMsg
          LedgerDB.MetadataBackendMismatch ->
             " Snapshot was created for a different backend. Convert it with `snapshot-converter`."
        _ -> ""

  forMachine dtals (LedgerDB.TookSnapshot snap pt enclosedTiming) =
    mconcat [ "kind" .= String "TookSnapshot"
             , "snapshot" .= forMachine dtals snap
             , "tip" .= show pt
             , "enclosedTime" .= enclosedTiming
             ]
  forMachine dtals (LedgerDB.DeletedSnapshot snap) =
    mconcat [ "kind" .= String "DeletedSnapshot"
             , "snapshot" .= forMachine dtals snap ]
  forMachine dtals (LedgerDB.InvalidSnapshot snap failure) =
    mconcat [ "kind" .= String "InvalidSnapshot"
            , "snapshot" .= forMachine dtals snap
            , "failure" .= show failure ]

instance MetaTrace (LedgerDB.TraceSnapshotEvent blk) where
    namespaceFor LedgerDB.TookSnapshot {} = Namespace [] ["TookSnapshot"]
    namespaceFor LedgerDB.DeletedSnapshot {} = Namespace [] ["DeletedSnapshot"]
    namespaceFor LedgerDB.InvalidSnapshot {} = Namespace [] ["InvalidSnapshot"]

    severityFor  (Namespace _ ["TookSnapshot"]) _ = Just Info
    severityFor  (Namespace _ ["DeletedSnapshot"]) _ = Just Debug
    severityFor  (Namespace _ ["InvalidSnapshot"]) _ = Just Error
    severityFor _ _ = Nothing

    documentFor (Namespace _ ["TookSnapshot"]) = Just $ mconcat
         [ "A snapshot is being written to disk. Two events will be traced, one"
         , " for when the node starts taking the snapshot and another one for"
         , " when the snapshot has been written to the disk."
         ]
    documentFor (Namespace _ ["DeletedSnapshot"]) = Just
          "A snapshot was deleted from the disk."
    documentFor (Namespace _ ["InvalidSnapshot"]) = Just $ mconcat
         [ "An on disk snapshot was invalid. Unless it was suffixed or"
         , " seems to be from an old node or different backend, it will"
         , " be deleted"
         ]
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["TookSnapshot"]
      , Namespace [] ["DeletedSnapshot"]
      , Namespace [] ["InvalidSnapshot"]
      ]

--------------------------------------------------------------------------------
-- LedgerDB TraceReplayEvent
--------------------------------------------------------------------------------

instance (StandardHash blk, ConvertRawHash blk)
          => LogFormatting (LedgerDB.TraceReplayEvent blk) where

  forHuman (LedgerDB.TraceReplayStartEvent ev') = forHuman ev'
  forHuman (LedgerDB.TraceReplayProgressEvent ev') = forHuman ev'

  forMachine dtal (LedgerDB.TraceReplayStartEvent ev') = forMachine dtal ev'
  forMachine dtal (LedgerDB.TraceReplayProgressEvent ev') = forMachine dtal ev'

instance (StandardHash blk, ConvertRawHash blk)
          => LogFormatting (LedgerDB.TraceReplayStartEvent blk) where
  forHuman LedgerDB.ReplayFromGenesis =
      "Replaying ledger from genesis"
  forHuman (LedgerDB.ReplayFromSnapshot snap (LedgerDB.ReplayStart tip')) =
      "Replaying ledger from snapshot " <> showT snap <> " at " <>
        renderPointAsPhrase tip'

  forMachine _dtal LedgerDB.ReplayFromGenesis =
      mconcat [ "kind" .= String "ReplayFromGenesis" ]
  forMachine dtal (LedgerDB.ReplayFromSnapshot snap tip') =
      mconcat [ "kind" .= String "ReplayFromSnapshot"
               , "snapshot" .= forMachine dtal snap
               , "tip" .= showT tip' ]

instance (StandardHash blk, ConvertRawHash blk)
          => LogFormatting (LedgerDB.TraceReplayProgressEvent blk) where
  forHuman (LedgerDB.ReplayedBlock
              pt
              _ledgerEvents
              (LedgerDB.ReplayStart replayFrom)
              (LedgerDB.ReplayGoal replayTo)) =
          let fromSlot = withOrigin 0 id $ unSlotNo <$> pointSlot replayFrom
              atSlot   = unSlotNo $ realPointSlot pt
              atDiff   = atSlot - fromSlot
              toSlot   = withOrigin 0 id $ unSlotNo <$> pointSlot replayTo
              toDiff   = toSlot - fromSlot
          in
             "Replayed block: slot "
          <> showT atSlot
          <> " out of "
          <> showT toSlot
          <> ". Progress: "
          <> showProgressT (fromIntegral atDiff) (fromIntegral toDiff)
          <> "%"

  forMachine _dtal (LedgerDB.ReplayedBlock
                      pt
                      _ledgerEvents
                      _
                      (LedgerDB.ReplayGoal replayTo)) =
      mconcat [ "kind" .= String "ReplayedBlock"
               , "slot" .= unSlotNo (realPointSlot pt)
               , "tip"  .= withOrigin 0 unSlotNo (pointSlot replayTo) ]

instance MetaTrace (LedgerDB.TraceReplayEvent blk) where
    namespaceFor (LedgerDB.TraceReplayStartEvent ev) =
      nsPrependInner "ReplayStart" (namespaceFor ev)
    namespaceFor (LedgerDB.TraceReplayProgressEvent ev) =
      nsPrependInner "ReplayProgress" (namespaceFor ev)

    severityFor (Namespace out ("ReplayStart" : tl)) Nothing =
      severityFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayStartEvent blk)) Nothing
    severityFor (Namespace out ("ReplayStart" : tl)) (Just (LedgerDB.TraceReplayStartEvent ev)) =
      severityFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayStartEvent blk)) (Just ev)
    severityFor (Namespace out ("ReplayProgress" : tl)) Nothing =
      severityFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayProgressEvent blk)) Nothing
    severityFor (Namespace out ("ReplayProgress" : tl)) (Just (LedgerDB.TraceReplayProgressEvent ev)) =
      severityFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayProgressEvent blk)) (Just ev)
    severityFor _ _ = Nothing

    documentFor (Namespace out ("ReplayStart" : tl)) =
      documentFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayStartEvent blk))
    documentFor (Namespace out ("ReplayProgress" : tl)) =
      documentFor (Namespace out tl :: Namespace (LedgerDB.TraceReplayProgressEvent blk))
    documentFor _ = Nothing

    allNamespaces =
      map (nsPrependInner "ReplayStart")
        (allNamespaces :: [Namespace (LedgerDB.TraceReplayStartEvent blk)])
      ++ map (nsPrependInner "ReplayProgress")
        (allNamespaces :: [Namespace (LedgerDB.TraceReplayProgressEvent blk)])

instance MetaTrace (LedgerDB.TraceReplayStartEvent blk) where
    namespaceFor LedgerDB.ReplayFromGenesis {} = Namespace [] ["ReplayFromGenesis"]
    namespaceFor LedgerDB.ReplayFromSnapshot {} = Namespace [] ["ReplayFromSnapshot"]

    severityFor  (Namespace _ ["ReplayFromGenesis"]) _ = Just Info
    severityFor  (Namespace _ ["ReplayFromSnapshot"]) _ = Just Info
    severityFor _ _ = Nothing

    documentFor (Namespace _ ["ReplayFromGenesis"]) = Just $ mconcat
      [ "There were no LedgerDB snapshots on disk, so we're replaying all"
      , " blocks starting from Genesis against the initial ledger."
      , " The @replayTo@ parameter corresponds to the block at the tip of the"
      , " ImmDB, i.e., the last block to replay."
      ]
    documentFor (Namespace _ ["ReplayFromSnapshot"]) = Just $ mconcat
      [ "There was a LedgerDB snapshot on disk corresponding to the given tip."
      , " We're replaying more recent blocks against it."
      , " The @replayTo@ parameter corresponds to the block at the tip of the"
      , " ImmDB, i.e., the last block to replay."
      ]
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["ReplayFromGenesis"]
      , Namespace [] ["ReplayFromSnapshot"]
      ]

instance MetaTrace (LedgerDB.TraceReplayProgressEvent blk) where
    namespaceFor LedgerDB.ReplayedBlock {} = Namespace [] ["ReplayedBlock"]

    severityFor  (Namespace _ ["ReplayedBlock"]) _ = Just Info
    severityFor _ _ = Nothing

    documentFor (Namespace _ ["ReplayedBlock"]) = Just $ mconcat
      [ "We replayed the given block (reference) on the genesis snapshot"
      , " during the initialisation of the LedgerDB."
      , "\n"
      , " The @blockInfo@ parameter corresponds replayed block and the @replayTo@"
      , " parameter corresponds to the block at the tip of the ImmDB, i.e.,"
      , " the last block to replay."
      ]
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["ReplayedBlock"]
      ]

--------------------------------------------------------------------------------
-- Forker events
--------------------------------------------------------------------------------

instance LogFormatting LedgerDB.TraceForkerEventWithKey where
  forMachine dtals (LedgerDB.TraceForkerEventWithKey k ev) =
    (\ev' -> mconcat [ "key" .= showT k, "event" .= ev' ]) $ forMachine dtals ev
  forHuman (LedgerDB.TraceForkerEventWithKey k ev) =
    "Forker " <> showT k <> ": " <> forHuman ev

instance LogFormatting LedgerDB.TraceForkerEvent where
  forMachine _dtals LedgerDB.ForkerOpen = mempty
  forMachine _dtals LedgerDB.ForkerCloseUncommitted = mempty
  forMachine _dtals LedgerDB.ForkerCloseCommitted = mempty
  forMachine _dtals LedgerDB.ForkerReadTablesStart = mempty
  forMachine _dtals LedgerDB.ForkerReadTablesEnd = mempty
  forMachine _dtals LedgerDB.ForkerRangeReadTablesStart = mempty
  forMachine _dtals LedgerDB.ForkerRangeReadTablesEnd = mempty
  forMachine _dtals LedgerDB.ForkerReadStatistics = mempty
  forMachine _dtals LedgerDB.ForkerPushStart = mempty
  forMachine _dtals LedgerDB.ForkerPushEnd = mempty
  forMachine _dtals LedgerDB.DanglingForkerClosed = mempty

  forHuman LedgerDB.ForkerOpen = "Opened forker"
  forHuman LedgerDB.ForkerCloseUncommitted = "Forker closed without committing"
  forHuman LedgerDB.ForkerCloseCommitted = "Forker closed after committing"
  forHuman LedgerDB.ForkerReadTablesStart = "Started to read tables"
  forHuman LedgerDB.ForkerReadTablesEnd = "Finish reading tables"
  forHuman LedgerDB.ForkerRangeReadTablesStart = "Started to range read tables"
  forHuman LedgerDB.ForkerRangeReadTablesEnd = "Finish range reading tables"
  forHuman LedgerDB.ForkerReadStatistics = "Gathering statistics"
  forHuman LedgerDB.ForkerPushStart = "Started to push"
  forHuman LedgerDB.ForkerPushEnd = "Pushed"
  forHuman LedgerDB.DanglingForkerClosed = "Closed dangling forker"

instance MetaTrace LedgerDB.TraceForkerEventWithKey where
  namespaceFor (LedgerDB.TraceForkerEventWithKey _ ev) =
    nsCast $ namespaceFor ev
  severityFor ns (Just (LedgerDB.TraceForkerEventWithKey _ ev)) =
    severityFor (nsCast ns) (Just ev)
  severityFor (Namespace out tl) Nothing =
    severityFor (Namespace out tl :: Namespace LedgerDB.TraceForkerEvent) Nothing
  documentFor = documentFor @LedgerDB.TraceForkerEvent . nsCast
  allNamespaces = map nsCast $ allNamespaces @LedgerDB.TraceForkerEvent

instance MetaTrace LedgerDB.TraceForkerEvent where
  namespaceFor LedgerDB.ForkerOpen = Namespace [] ["Open"]
  namespaceFor LedgerDB.ForkerCloseUncommitted = Namespace [] ["CloseUncommitted"]
  namespaceFor LedgerDB.ForkerCloseCommitted = Namespace [] ["CloseCommitted"]
  namespaceFor LedgerDB.ForkerReadTablesStart = Namespace [] ["StartRead"]
  namespaceFor LedgerDB.ForkerReadTablesEnd = Namespace [] ["FinishRead"]
  namespaceFor LedgerDB.ForkerRangeReadTablesStart = Namespace [] ["StartRangeRead"]
  namespaceFor LedgerDB.ForkerRangeReadTablesEnd = Namespace [] ["FinishRangeRead"]
  namespaceFor LedgerDB.ForkerReadStatistics = Namespace [] ["Statistics"]
  namespaceFor LedgerDB.ForkerPushStart = Namespace [] ["StartPush"]
  namespaceFor LedgerDB.ForkerPushEnd = Namespace [] ["FinishPush"]
  namespaceFor LedgerDB.DanglingForkerClosed = Namespace [] ["DanglingForkerClosed"]

  severityFor _ _ = Just Debug

  documentFor (Namespace _ ("Open" : _tl)) = Just
   "A forker is being opened"
  documentFor (Namespace _ ("CloseUncommitted" : _tl)) = Just $
   mconcat [ "A forker was closed without being committed."
           , " This is usually the case with forkers that are not opened for chain selection,"
           , " and for forkers on discarded forks"]
  documentFor (Namespace _ ("CloseCommitted" : _tl)) = Just "A forker was committed (the LedgerDB was modified accordingly) and closed"
  documentFor (Namespace _ ("StartRead" : _tl)) = Just "The process for reading ledger tables started"
  documentFor (Namespace _ ("FinishRead" : _tl)) = Just "Values from the ledger tables were read"
  documentFor (Namespace _ ("StartRangeRead" : _tl)) = Just "The process for range reading ledger tables started"
  documentFor (Namespace _ ("FinishRangeRead" : _tl)) = Just "Values from the ledger tables were range-read"
  documentFor (Namespace _ ("Statistics" : _tl)) = Just "Statistics were gathered from the forker"
  documentFor (Namespace _ ("StartPush" : _tl)) = Just "A ledger state is going to be pushed to the forker"
  documentFor (Namespace _ ("FinishPush" : _tl)) = Just "A ledger state was pushed to the forker"
  documentFor (Namespace _ ("DanglingForkerClosed" : _tl)) = Just "A dangling forker was closed"
  documentFor _ = Nothing

  allNamespaces = [
      Namespace [] ["Open"]
    , Namespace [] ["CloseUncommitted"]
    , Namespace [] ["CloseCommitted"]
    , Namespace [] ["StartRead"]
    , Namespace [] ["FinishRead"]
    , Namespace [] ["StartRangeRead"]
    , Namespace [] ["FinishRangeRead"]
    , Namespace [] ["Statistics"]
    , Namespace [] ["StartPush"]
    , Namespace [] ["FinishPush"]
    , Namespace [] ["DanglingForkerClosed"]
    ]

--------------------------------------------------------------------------------
-- Flavor specific trace
--------------------------------------------------------------------------------

instance LogFormatting LedgerDB.FlavorImplSpecificTrace where
  forMachine dtal (LedgerDB.FlavorImplSpecificTraceV1 ev) = forMachine dtal ev
  forMachine dtal (LedgerDB.FlavorImplSpecificTraceV2 ev) = forMachine dtal ev

  forHuman (LedgerDB.FlavorImplSpecificTraceV1 ev) = forHuman ev
  forHuman (LedgerDB.FlavorImplSpecificTraceV2 ev) = forHuman ev

instance MetaTrace LedgerDB.FlavorImplSpecificTrace where
  namespaceFor (LedgerDB.FlavorImplSpecificTraceV1 ev) =
    nsPrependInner "V1" (namespaceFor ev)
  namespaceFor (LedgerDB.FlavorImplSpecificTraceV2 ev) =
    nsPrependInner "V2" (namespaceFor ev)

  severityFor (Namespace out ("V1" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTrace) Nothing
  severityFor (Namespace out ("V1" : tl)) (Just (LedgerDB.FlavorImplSpecificTraceV1 ev)) =
    severityFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTrace) (Just ev)
  severityFor (Namespace out ("V2" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace V2.FlavorImplSpecificTrace) Nothing
  severityFor (Namespace out ("V2" : tl)) (Just (LedgerDB.FlavorImplSpecificTraceV2 ev)) =
    severityFor (Namespace out tl :: Namespace V2.FlavorImplSpecificTrace) (Just ev)
  severityFor _ _ = Nothing

  documentFor (Namespace out ("V1" : tl)) =
    documentFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTrace)
  documentFor (Namespace out ("V2" : tl)) =
    documentFor (Namespace out tl :: Namespace V2.FlavorImplSpecificTrace)
  documentFor _ = Nothing

  allNamespaces =
       map (nsPrependInner "V1")
         (allNamespaces :: [Namespace V1.FlavorImplSpecificTrace])
    ++ map (nsPrependInner "V2")
         (allNamespaces :: [Namespace V2.FlavorImplSpecificTrace])

--------------------------------------------------------------------------------
-- V1
--------------------------------------------------------------------------------

instance LogFormatting V1.FlavorImplSpecificTrace where
  forMachine dtal (V1.FlavorImplSpecificTraceInMemory ev) = forMachine dtal ev
  forMachine dtal (V1.FlavorImplSpecificTraceOnDisk ev) = forMachine dtal ev

  forHuman (V1.FlavorImplSpecificTraceInMemory ev) = forHuman ev
  forHuman (V1.FlavorImplSpecificTraceOnDisk ev) = forHuman ev

instance LogFormatting V1.FlavorImplSpecificTraceInMemory where
  forMachine _dtal V1.InMemoryBackingStoreInitialise = mempty
  forMachine dtal (V1.InMemoryBackingStoreTrace ev) = forMachine dtal ev

  forHuman V1.InMemoryBackingStoreInitialise = "Initializing in-memory backing store"
  forHuman (V1.InMemoryBackingStoreTrace ev) = forHuman ev

instance LogFormatting V1.FlavorImplSpecificTraceOnDisk where
  forMachine _dtal (V1.OnDiskBackingStoreInitialise limits) =
    mconcat [ "limits" .= showT limits ]
  forMachine dtal (V1.OnDiskBackingStoreTrace ev) = forMachine dtal ev

  forHuman (V1.OnDiskBackingStoreInitialise limits) = "Initializing on-disk backing store with limits " <> showT limits
  forHuman (V1.OnDiskBackingStoreTrace ev) = forHuman ev

instance LogFormatting V1.BackingStoreTrace where
  forMachine _dtals V1.BSOpening = mempty
  forMachine _dtals (V1.BSOpened p) =
    maybe mempty (\p' -> mconcat [ "path" .= showT p' ]) p
  forMachine _dtals (V1.BSInitialisingFromCopy p) =
    mconcat [ "path" .= showT p ]
  forMachine _dtals (V1.BSInitialisedFromCopy p) =
    mconcat [ "path" .= showT p ]
  forMachine _dtals (V1.BSInitialisingFromValues sl) =
    mconcat [ "slot" .= showT sl ]
  forMachine _dtals (V1.BSInitialisedFromValues sl) =
    mconcat [ "slot" .= showT sl ]
  forMachine _dtals V1.BSClosing = mempty
  forMachine _dtals V1.BSAlreadyClosed = mempty
  forMachine _dtals V1.BSClosed = mempty
  forMachine _dtals (V1.BSCopying p) =
    mconcat [ "path" .= showT p ]
  forMachine _dtals (V1.BSCopied p) =
    mconcat [ "path" .= showT p ]
  forMachine _dtals V1.BSCreatingValueHandle = mempty
  forMachine _dtals V1.BSCreatedValueHandle = mempty
  forMachine _dtals (V1.BSWriting s) =
    mconcat [ "slot" .= showT s ]
  forMachine _dtals (V1.BSWritten s1 s2) =
    mconcat [ "old" .= showT s1, "new" .= showT s2 ]
  forMachine _dtals (V1.BSValueHandleTrace i _ev) =
    maybe mempty (\i' -> mconcat ["idx" .= showT i']) i
instance LogFormatting V1.BackingStoreValueHandleTrace where
  forMachine _dtals V1.BSVHClosing = mempty
  forMachine _dtals V1.BSVHAlreadyClosed = mempty
  forMachine _dtals V1.BSVHClosed = mempty
  forMachine _dtals V1.BSVHRangeReading = mempty
  forMachine _dtals V1.BSVHRangeRead = mempty
  forMachine _dtals V1.BSVHReading = mempty
  forMachine _dtals V1.BSVHRead = mempty
  forMachine _dtals V1.BSVHStatting = mempty
  forMachine _dtals V1.BSVHStatted = mempty

instance MetaTrace V1.FlavorImplSpecificTrace where
  namespaceFor (V1.FlavorImplSpecificTraceInMemory ev) =
    nsPrependInner "InMemory" (namespaceFor ev)
  namespaceFor (V1.FlavorImplSpecificTraceOnDisk ev) =
    nsPrependInner "OnDisk" (namespaceFor ev)

  severityFor (Namespace out ("InMemory" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTraceInMemory) Nothing
  severityFor (Namespace out ("InMemory" : tl)) (Just (V1.FlavorImplSpecificTraceInMemory ev)) =
    severityFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTraceInMemory) (Just ev)
  severityFor (Namespace out ("OnDisk" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTraceOnDisk) Nothing
  severityFor (Namespace out ("OnDisk" : tl)) (Just (V1.FlavorImplSpecificTraceOnDisk ev)) =
    severityFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTraceOnDisk) (Just ev)
  severityFor _ _ = Nothing

  documentFor (Namespace out ("InMemory" : tl)) =
    documentFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTraceInMemory)
  documentFor (Namespace out ("OnDisk" : tl)) =
    documentFor (Namespace out tl :: Namespace V1.FlavorImplSpecificTraceOnDisk)
  documentFor _ = Nothing

  allNamespaces =
    map (nsPrependInner "InMemory")
        (allNamespaces :: [Namespace V1.FlavorImplSpecificTraceInMemory])
    ++ map (nsPrependInner "OnDisk")
        (allNamespaces :: [Namespace V1.FlavorImplSpecificTraceOnDisk])

instance MetaTrace V1.FlavorImplSpecificTraceInMemory where
  namespaceFor V1.InMemoryBackingStoreInitialise = Namespace [] ["Initialise"]
  namespaceFor (V1.InMemoryBackingStoreTrace bsTrace) =
    nsPrependInner "BackingStoreEvent" (namespaceFor bsTrace)

  severityFor (Namespace _ ("Initialise" : _)) _ = Just Debug
  severityFor (Namespace out ("BackingStoreEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace V1.BackingStoreTrace) Nothing
  severityFor (Namespace out ("BackingStoreEvent" : tl)) (Just (V1.InMemoryBackingStoreTrace ev)) =
    severityFor (Namespace out tl :: Namespace V1.BackingStoreTrace) (Just ev)
  severityFor _ _ = Nothing

  documentFor (Namespace _ ("Initialise" : _)) = Just
    "Backing store is being initialised"
  documentFor (Namespace out ("BackingStoreEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace V1.BackingStoreTrace)
  documentFor _ = Nothing

  allNamespaces =
    Namespace [] ["Initialise"]
    : map (nsPrependInner "BackingStoreEvent")
          (allNamespaces :: [Namespace V1.BackingStoreTrace])

instance MetaTrace V1.FlavorImplSpecificTraceOnDisk where
  namespaceFor V1.OnDiskBackingStoreInitialise{} =
    Namespace [] ["Initialise"]
  namespaceFor (V1.OnDiskBackingStoreTrace ev) =
    nsPrependInner "BackingStoreEvent" (namespaceFor ev)

  severityFor (Namespace _ ("Initialise" : _)) _ = Just Debug
  severityFor (Namespace out ("BackingStoreEvent" : tl)) Nothing =
    severityFor (Namespace out tl :: Namespace V1.BackingStoreTrace) Nothing
  severityFor (Namespace out ("BackingStoreEvent" : tl)) (Just (V1.OnDiskBackingStoreTrace ev)) =
    severityFor (Namespace out tl :: Namespace V1.BackingStoreTrace) (Just ev)
  severityFor _ _ = Nothing

  documentFor (Namespace _ ("Initialise" : _)) = Just
    "Backing store is being initialised"
  documentFor (Namespace out ("BackingStoreEvent" : tl)) =
    documentFor (Namespace out tl :: Namespace V1.BackingStoreTrace)
  documentFor _ = Nothing

  allNamespaces =
    Namespace [] ["Initialise"]
    : map (nsPrependInner "BackingStoreEvent")
          (allNamespaces :: [Namespace V1.BackingStoreTrace])

instance MetaTrace V1.BackingStoreTrace where
  namespaceFor V1.BSOpening = Namespace [] ["Opening"]
  namespaceFor V1.BSOpened{} = Namespace [] ["Opened"]
  namespaceFor V1.BSInitialisingFromCopy{} =
    Namespace [] ["InitialisingFromCopy"]
  namespaceFor V1.BSInitialisedFromCopy{} =
    Namespace [] ["InitialisedFromCopy"]
  namespaceFor V1.BSInitialisingFromValues{} =
    Namespace [] ["InitialisingFromValues"]
  namespaceFor V1.BSInitialisedFromValues{} =
    Namespace [] ["InitialisedFromValues"]
  namespaceFor V1.BSClosing = Namespace [] ["Closing"]
  namespaceFor V1.BSAlreadyClosed = Namespace [] ["AlreadyClosed"]
  namespaceFor V1.BSClosed = Namespace [] ["Closed"]
  namespaceFor V1.BSCopying{} = Namespace [] ["Copying"]
  namespaceFor V1.BSCopied{} = Namespace [] ["Copied"]
  namespaceFor V1.BSCreatingValueHandle = Namespace [] ["CreatingValueHandle"]
  namespaceFor V1.BSCreatedValueHandle = Namespace [] ["CreatedValueHandle"]
  namespaceFor (V1.BSValueHandleTrace _ bsValueHandleTrace) =
    nsPrependInner "ValueHandleTrace" (namespaceFor bsValueHandleTrace)
  namespaceFor V1.BSWriting{} = Namespace [] ["Writing"]
  namespaceFor V1.BSWritten{} = Namespace [] ["Written"]

  severityFor (Namespace _ ("Opening" : _)) _ = Just Debug
  severityFor (Namespace _ ("Opened" : _)) _ = Just Debug
  severityFor (Namespace _ ("InitialisingFromCopy" : _)) _ = Just Debug
  severityFor (Namespace _ ("InitialisedFromCopy" : _)) _ = Just Debug
  severityFor (Namespace _ ("InitialisingFromValues" : _)) _ = Just Debug
  severityFor (Namespace _ ("InitialisedFromValues" : _)) _ = Just Debug
  severityFor (Namespace _ ("Closing" : _)) _ = Just Debug
  severityFor (Namespace _ ("AlreadyClosed" : _)) _ = Just Debug
  severityFor (Namespace _ ("Closed" : _)) _ = Just Debug
  severityFor (Namespace _ ("Copying" : _)) _ = Just Debug
  severityFor (Namespace _ ("Copied" : _)) _ = Just Debug
  severityFor (Namespace _ ("CreatingValueHandle" : _)) _ = Just Debug
  severityFor (Namespace _ ("CreatedValueHandle" : _)) _ = Just Debug
  severityFor (Namespace out ("ValueHandleTrace" : t1)) Nothing =
    severityFor
      (Namespace out t1 :: Namespace V1.BackingStoreValueHandleTrace)
      Nothing
  severityFor
    (Namespace out ("ValueHandleTrace" : t1))
    (Just (V1.BSValueHandleTrace _ bsValueHandleTrace)) =
      severityFor
        (Namespace out t1 :: Namespace V1.BackingStoreValueHandleTrace)
        (Just bsValueHandleTrace)
  severityFor (Namespace _ ("Writing" : _)) _ = Just Debug
  severityFor (Namespace _ ("Written" : _)) _ = Just Debug
  severityFor _ _ = Nothing

  documentFor (Namespace _ ("Opening" : _ )) = Just
    "Opening backing store"
  documentFor (Namespace _ ("Opened" : _ )) = Just
    "Backing store opened"
  documentFor (Namespace _ ("InitialisingFromCopy" : _ )) = Just
    "Initialising backing store from copy"
  documentFor (Namespace _ ("InitialisedFromCopy" : _ )) = Just
    "Backing store initialised from copy"
  documentFor (Namespace _ ("InitialisingFromValues" : _ )) = Just
    "Initialising backing store from values"
  documentFor (Namespace _ ("InitialisedFromValues" : _ )) = Just
    "Backing store initialised from values"
  documentFor (Namespace _ ("Closing" : _ )) = Just
    "Closing backing store"
  documentFor (Namespace _ ("AlreadyClosed" : _ )) = Just
    "Backing store is already closed"
  documentFor (Namespace _ ("Closed" : _ )) = Just
    "Backing store closed"
  documentFor (Namespace _ ("Copying" : _ )) = Just
    "Copying backing store"
  documentFor (Namespace _ ("Copied" : _ )) = Just
    "Backing store copied"
  documentFor (Namespace _ ("CreatingValueHandle" : _ )) = Just
    "Creating value handle for backing store"
  documentFor (Namespace _ ("CreatedValueHandle" : _ )) = Just
    "Value handle for backing store created"
  documentFor (Namespace out ("ValueHandleTrace" : t1 )) =
    documentFor (Namespace out t1 :: Namespace V1.BackingStoreValueHandleTrace)
  documentFor (Namespace _ ("Writing" : _ )) = Just
    "Writing backing store"
  documentFor (Namespace _ ("Written" : _ )) = Just
    "Backing store written"
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["Opening"]
    , Namespace [] ["Opened"]
    , Namespace [] ["InitialisingFromCopy"]
    , Namespace [] ["InitialisedFromCopy"]
    , Namespace [] ["InitialisingFromValues"]
    , Namespace [] ["InitialisedFromValues"]
    , Namespace [] ["Closing"]
    , Namespace [] ["AlreadyClosed"]
    , Namespace [] ["Closed"]
    , Namespace [] ["Copying"]
    , Namespace [] ["Copied"]
    , Namespace [] ["CreatingValueHandle"]
    , Namespace [] ["CreatedValueHandle"]
    , Namespace [] ["Writing"]
    , Namespace [] ["Written"]
    ] ++ map (nsPrependInner "ValueHandleTrace")
             (allNamespaces :: [Namespace V1.BackingStoreValueHandleTrace])


instance MetaTrace V1.BackingStoreValueHandleTrace where
  namespaceFor V1.BSVHClosing = Namespace [] ["Closing"]
  namespaceFor V1.BSVHAlreadyClosed = Namespace [] ["AlreadyClosed"]
  namespaceFor V1.BSVHClosed = Namespace [] ["Closed"]
  namespaceFor V1.BSVHRangeReading = Namespace [] ["RangeReading"]
  namespaceFor V1.BSVHRangeRead = Namespace [] ["RangeRead"]
  namespaceFor V1.BSVHReading = Namespace [] ["Reading"]
  namespaceFor V1.BSVHRead = Namespace [] ["Read"]
  namespaceFor V1.BSVHStatting = Namespace [] ["Statting"]
  namespaceFor V1.BSVHStatted = Namespace [] ["Statted"]

  severityFor (Namespace _ ("Closing" : _ )) _ = Just Debug
  severityFor (Namespace _ ("AlreadyClosed" : _ )) _ = Just Debug
  severityFor (Namespace _ ("Closed" : _ )) _ = Just Debug
  severityFor (Namespace _ ("RangeReading" : _ )) _ = Just Debug
  severityFor (Namespace _ ("RangeRead" : _ )) _ = Just Debug
  severityFor (Namespace _ ("Reading" : _ )) _ = Just Debug
  severityFor (Namespace _ ("Read" : _ )) _ = Just Debug
  severityFor (Namespace _ ("Statting" : _ )) _ = Just Debug
  severityFor (Namespace _ ("Statted" : _ )) _ = Just Debug
  severityFor _ _ = Nothing

  documentFor (Namespace _ ("Closing" : _ )) = Just
    "Closing backing store value handle"
  documentFor (Namespace _ ("AlreadyClosed" : _ )) = Just
    "Backing store value handle already clsoed"
  documentFor (Namespace _ ("Closed" : _ )) = Just
    "Backing store value handle closed"
  documentFor (Namespace _ ("RangeReading" : _ )) = Just
    "Reading range for backing store value handle"
  documentFor (Namespace _ ("RangeRead" : _ )) = Just
    "Range for backing store value handle read"
  documentFor (Namespace _ ("Reading" : _ )) = Just
    "Reading backing store value handle"
  documentFor (Namespace _ ("Read" : _ )) = Just
    "Backing store value handle read"
  documentFor (Namespace _ ("Statting" : _ )) = Just
    "Statting backing store value handle"
  documentFor (Namespace _ ("Statted" : _ )) = Just
    "Backing store value handle statted"
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["Closing"]
    , Namespace [] ["AlreadyClosed"]
    , Namespace [] ["Closed"]
    , Namespace [] ["RangeReading"]
    , Namespace [] ["RangeRead"]
    , Namespace [] ["Reading"]
    , Namespace [] ["Read"]
    , Namespace [] ["Statting"]
    , Namespace [] ["Statted"]
    ]

instance LogFormatting V2.FlavorImplSpecificTrace where
  forMachine _dtal V2.TraceLedgerTablesHandleCreate =
    mconcat [ "kind" .= String "LedgerTablesHandleCreate" ]
  forMachine _dtal V2.TraceLedgerTablesHandleClose =
    mconcat [ "kind" .= String "LedgerTablesHandleClose" ]

  forHuman V2.TraceLedgerTablesHandleCreate =
    "Created a new 'LedgerTablesHandle', potentially by duplicating an existing one"
  forHuman V2.TraceLedgerTablesHandleClose =
    "Closed a 'LedgerTablesHandle'"

instance MetaTrace V2.FlavorImplSpecificTrace where
  namespaceFor V2.TraceLedgerTablesHandleCreate =
    Namespace [] ["LedgerTablesHandleCreate"]
  namespaceFor V2.TraceLedgerTablesHandleClose =
    Namespace [] ["LedgerTablesHandleClose"]

  severityFor (Namespace _ ["LedgerTablesHandleCreate"]) _ = Just Debug
  severityFor (Namespace _ ["LedgerTablesHandleClose"])   _ = Just Debug
  severityFor _                          _ = Nothing

  -- suspicious
  privacyFor (Namespace _ ["LedgerTablesHandleCreate"]) _ = Just Public
  privacyFor (Namespace _ ["LedgerTablesHandleClose"])   _ = Just Public
  privacyFor _                          _ = Just Public

  documentFor (Namespace _ ["LedgerTablesHandleCreate"]) =
    Just "An in-memory backing store event"
  documentFor (Namespace _ ["LedgerTablesHandleClose"]) =
    Just "An on-disk backing store event"
  documentFor _ = Nothing

  allNamespaces =
    [ Namespace [] ["LedgerTablesHandleCreate"]
    , Namespace [] ["LedgerTablesHandleClose"]
    ]

--------------------------------------------------------------------------------
-- ImmDB.TraceEvent
--------------------------------------------------------------------------------

instance (ConvertRawHash blk, StandardHash blk)
  => LogFormatting (ImmDB.TraceEvent blk) where
    forMachine _dtal ImmDB.NoValidLastLocation =
      mconcat [ "kind" .= String "NoValidLastLocation" ]
    forMachine _dtal (ImmDB.ValidatedLastLocation chunkNo immTip) =
      mconcat [ "kind" .= String "ValidatedLastLocation"
               , "chunkNo" .= String (renderChunkNo chunkNo)
               , "immTip" .= String (renderTipHash immTip)
               , "blockNo" .= String (renderTipBlockNo immTip)
               ]
    forMachine dtal (ImmDB.ChunkValidationEvent traceChunkValidation) =
      forMachine dtal traceChunkValidation
    forMachine _dtal (ImmDB.DeletingAfter immTipWithInfo) =
      mconcat [ "kind" .= String "DeletingAfter"
               , "immTipHash" .= String (renderWithOrigin renderTipHash immTipWithInfo)
               , "immTipBlockNo" .= String (renderWithOrigin renderTipBlockNo immTipWithInfo)
               ]
    forMachine _dtal ImmDB.DBAlreadyClosed =
      mconcat [ "kind" .= String "DBAlreadyClosed" ]
    forMachine _dtal ImmDB.DBClosed =
      mconcat [ "kind" .= String "DBClosed" ]
    forMachine dtal (ImmDB.TraceCacheEvent cacheEv) =
      forMachine dtal cacheEv
    forMachine _dtal (ImmDB.ChunkFileDoesntFit expectPrevHash actualPrevHash) =
      mconcat [ "kind" .= String "ChunkFileDoesntFit"
               , "expectedPrevHash" .= String (renderChainHash (Text.decodeLatin1 .
                                              toRawHash (Proxy @blk)) expectPrevHash)
               , "actualPrevHash" .= String (renderChainHash (Text.decodeLatin1 .
                                              toRawHash (Proxy @blk)) actualPrevHash)
               ]
    forMachine _dtal (ImmDB.Migrating txt) =
      mconcat [ "kind" .= String "Migrating"
               , "info" .= String txt
               ]

    forHuman ImmDB.NoValidLastLocation =
          "No valid last location was found. Starting from Genesis."
    forHuman (ImmDB.ValidatedLastLocation cn t) =
            "Found a valid last location at chunk "
          <> showT cn
          <> " with tip "
          <> renderRealPoint (ImmDB.tipToRealPoint t)
          <> "."
    forHuman (ImmDB.ChunkValidationEvent e) = case e of
          ImmDB.StartedValidatingChunk chunkNo outOf ->
               "Validating chunk no. " <> showT chunkNo <> " out of " <> showT outOf
            <> ". Progress: " <> showProgressT (chunkNoToInt chunkNo) (chunkNoToInt outOf + 1) <> "%"
          ImmDB.ValidatedChunk chunkNo outOf ->
               "Validated chunk no. " <> showT chunkNo <> " out of " <> showT outOf
            <> ". Progress: " <> showProgressT (chunkNoToInt chunkNo + 1) (chunkNoToInt outOf + 1) <> "%"
          ImmDB.MissingChunkFile cn      ->
            "The chunk file with number " <> showT cn <> " is missing."
          ImmDB.InvalidChunkFile cn er    ->
            "The chunk file with number " <> showT cn <> " is invalid: " <> showT er
          ImmDB.MissingPrimaryIndex cn   ->
            "The primary index of the chunk file with number " <> showT cn <> " is missing."
          ImmDB.MissingSecondaryIndex cn ->
            "The secondary index of the chunk file with number " <> showT cn <> " is missing."
          ImmDB.InvalidPrimaryIndex cn   ->
            "The primary index of the chunk file with number " <> showT cn <> " is invalid."
          ImmDB.InvalidSecondaryIndex cn ->
            "The secondary index of the chunk file with number " <> showT cn <> " is invalid."
          ImmDB.RewritePrimaryIndex cn   ->
            "Rewriting the primary index for the chunk file with number " <> showT cn <> "."
          ImmDB.RewriteSecondaryIndex cn ->
            "Rewriting the secondary index for the chunk file with number " <> showT cn <> "."
    forHuman (ImmDB.ChunkFileDoesntFit ch1 ch2 ) =
          "Chunk file doesn't fit. The hash of the block " <> showT ch2 <> " doesn't match the previous hash of the first block in the current epoch: " <> showT ch1 <> "."
    forHuman (ImmDB.Migrating t) = "Migrating: " <> t
    forHuman (ImmDB.DeletingAfter wot) = "Deleting chunk files after " <> showT wot
    forHuman ImmDB.DBAlreadyClosed {} = "Immutable DB was already closed. Double closing."
    forHuman ImmDB.DBClosed {} = "Closed Immutable DB."
    forHuman (ImmDB.TraceCacheEvent ev') = "Cache event: " <> case ev' of
          ImmDB.TraceCurrentChunkHit   cn   curr -> "Current chunk hit: " <> showT cn <> ", cache size: " <> showT curr
          ImmDB.TracePastChunkHit      cn   curr -> "Past chunk hit: " <> showT cn <> ", cache size: " <> showT curr
          ImmDB.TracePastChunkMiss     cn   curr -> "Past chunk miss: " <> showT cn <> ", cache size: " <> showT curr
          ImmDB.TracePastChunkEvict    cn   curr -> "Past chunk evict: " <> showT cn <> ", cache size: " <> showT curr
          ImmDB.TracePastChunksExpired cns  curr -> "Past chunks expired: " <> showT cns <> ", cache size: " <> showT curr


instance MetaTrace (ImmDB.TraceEvent blk) where
    namespaceFor ImmDB.NoValidLastLocation {} = Namespace [] ["NoValidLastLocation"]
    namespaceFor ImmDB.ValidatedLastLocation {} = Namespace [] ["ValidatedLastLocation"]
    namespaceFor (ImmDB.ChunkValidationEvent ev) =
      nsPrependInner "ChunkValidation" (namespaceFor ev)
    namespaceFor ImmDB.ChunkFileDoesntFit {} = Namespace [] ["ChunkFileDoesntFit"]
    namespaceFor ImmDB.Migrating {} = Namespace [] ["Migrating"]
    namespaceFor ImmDB.DeletingAfter {} = Namespace [] ["DeletingAfter"]
    namespaceFor ImmDB.DBAlreadyClosed {} = Namespace [] ["DBAlreadyClosed"]
    namespaceFor ImmDB.DBClosed {} = Namespace [] ["DBClosed"]
    namespaceFor (ImmDB.TraceCacheEvent ev) =
      nsPrependInner "CacheEvent" (namespaceFor ev)

    severityFor  (Namespace _ ["NoValidLastLocation"]) _ = Just Info
    severityFor  (Namespace _ ["ValidatedLastLocation"]) _ = Just Info
    severityFor (Namespace out ("ChunkValidation" : tl))
                    (Just (ImmDB.ChunkValidationEvent ev')) =
      severityFor (Namespace out tl) (Just ev')
    severityFor (Namespace out ("ChunkValidation" : tl)) Nothing =
      severityFor (Namespace out tl :: Namespace (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo)) Nothing

    severityFor (Namespace out ("ChunkValidationEvent" : tl)) Nothing =
      severityFor (Namespace out tl :: Namespace (ImmDB.TraceChunkValidation blk chunkNo)) Nothing
    severityFor  (Namespace _ ["ChunkFileDoesntFit"]) _ = Just Warning
    severityFor  (Namespace _ ["Migrating"]) _ = Just Debug
    severityFor  (Namespace _ ["DeletingAfter"]) _ = Just Debug
    severityFor  (Namespace _ ["DBAlreadyClosed"]) _ = Just Error
    severityFor  (Namespace _ ["DBClosed"]) _ = Just Info
    severityFor (Namespace out ("CacheEvent" : tl))
                    (Just (ImmDB.TraceCacheEvent ev')) =
      severityFor (Namespace out tl) (Just ev')
    severityFor (Namespace out ("CacheEvent" : tl)) Nothing =
      severityFor (Namespace out tl :: Namespace ImmDB.TraceCacheEvent) Nothing
    severityFor _ _ = Nothing

    privacyFor (Namespace out ("ChunkValidation" : tl))
                    (Just (ImmDB.ChunkValidationEvent ev')) =
      privacyFor (Namespace out tl) (Just ev')
    privacyFor (Namespace out ("ChunkValidationEvent" : tl)) Nothing =
      privacyFor (Namespace out tl :: Namespace (ImmDB.TraceChunkValidation blk chunkNo)) Nothing
    privacyFor (Namespace out ("CacheEvent" : tl))
                    (Just (ImmDB.TraceCacheEvent ev')) =
      privacyFor (Namespace out tl) (Just ev')
    privacyFor _ _ = Just Public

    detailsFor (Namespace out ("ChunkValidation" : tl))
                    (Just (ImmDB.ChunkValidationEvent ev')) =
      detailsFor (Namespace out tl) (Just ev')
    detailsFor (Namespace out ("ChunkValidationEvent" : tl)) Nothing =
      detailsFor (Namespace out tl :: Namespace (ImmDB.TraceChunkValidation blk chunkNo)) Nothing
    detailsFor (Namespace out ("CacheEvent" : tl))
                    (Just (ImmDB.TraceCacheEvent ev')) =
      detailsFor (Namespace out tl) (Just ev')
    detailsFor _ _ = Just DNormal

    documentFor (Namespace _ ["NoValidLastLocation"]) = Just
      "No valid last location was found"
    documentFor (Namespace _ ["ValidatedLastLocation"]) = Just
      "The last location was validatet"
    documentFor (Namespace o ("ChunkValidation" : tl)) =
       documentFor (Namespace o tl :: Namespace (ImmDB.TraceChunkValidation blk chunkNo))
    documentFor (Namespace _ ["ChunkFileDoesntFit"]) = Just $ mconcat
      [ "The hash of the last block in the previous epoch doesn't match the"
      , " previous hash of the first block in the current epoch"
      ]
    documentFor (Namespace _ ["Migrating"]) = Just
      "Performing a migration of the on-disk files."
    documentFor (Namespace _ ["DeletingAfter"]) = Just
      "Delete after"
    documentFor (Namespace _ ["DBAlreadyClosed"]) = Just
      ""
    documentFor (Namespace _ ["DBClosed"]) = Just
      "Closing the immutable DB"
    documentFor (Namespace o ("CacheEvent" : tl)) =
       documentFor (Namespace o tl :: Namespace ImmDB.TraceCacheEvent)
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["NoValidLastLocation"]
      , Namespace [] ["ValidatedLastLocation"]
      , Namespace [] ["ChunkFileDoesntFit"]
      , Namespace [] ["Migrating"]
      , Namespace [] ["DeletingAfter"]
      , Namespace [] ["DBAlreadyClosed"]
      , Namespace [] ["DBClosed"]
      ]
      ++ map  (nsPrependInner "ChunkValidation")
              (allNamespaces :: [Namespace (ImmDB.TraceChunkValidation blk chunkNo)])
      ++ map  (nsPrependInner "CacheEvent")
              (allNamespaces :: [Namespace ImmDB.TraceCacheEvent])

--------------------------------------------------------------------------------
-- ImmDB.TraceChunkValidation
--------------------------------------------------------------------------------

instance ConvertRawHash blk => LogFormatting (ImmDB.TraceChunkValidation blk ImmDB.ChunkNo) where
    forMachine _dtal (ImmDB.RewriteSecondaryIndex chunkNo) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.RewriteSecondaryIndex"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.RewritePrimaryIndex chunkNo) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.RewritePrimaryIndex"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.MissingPrimaryIndex chunkNo) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingPrimaryIndex"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.MissingSecondaryIndex chunkNo) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingSecondaryIndex"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.InvalidPrimaryIndex chunkNo) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidPrimaryIndex"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.InvalidSecondaryIndex chunkNo) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidSecondaryIndex"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.InvalidChunkFile chunkNo
                      (ImmDB.ChunkErrHashMismatch hashPrevBlock prevHashOfBlock)) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrHashMismatch"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 , "hashPrevBlock" .= String (Text.decodeLatin1 . toRawHash (Proxy @blk) $ hashPrevBlock)
                 , "prevHashOfBlock" .= String (renderChainHash (Text.decodeLatin1 . toRawHash (Proxy @blk)) prevHashOfBlock)
                 ]
    forMachine dtal (ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrCorrupt pt)) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrCorrupt"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 , "block" .= String (renderPointForDetails dtal pt)
                 ]
    forMachine _dtal (ImmDB.ValidatedChunk chunkNo _) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.ValidatedChunk"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.MissingChunkFile chunkNo) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.MissingChunkFile"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 ]
    forMachine _dtal (ImmDB.InvalidChunkFile chunkNo (ImmDB.ChunkErrRead readIncErr)) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.InvalidChunkFile.ChunkErrRead"
                 , "chunkNo" .= String (renderChunkNo chunkNo)
                 , "error" .= String (showT readIncErr)
                 ]
    forMachine _dtal (ImmDB.StartedValidatingChunk initialChunk finalChunk) =
        mconcat [ "kind" .= String "TraceImmutableDBEvent.StartedValidatingChunk"
                 , "initialChunk" .= renderChunkNo initialChunk
                 , "finalChunk" .= renderChunkNo finalChunk
                 ]

instance MetaTrace (ImmDB.TraceChunkValidation blk chunkNo) where
    namespaceFor ImmDB.StartedValidatingChunk {} = Namespace [] ["StartedValidatingChunk"]
    namespaceFor ImmDB.ValidatedChunk {} = Namespace [] ["ValidatedChunk"]
    namespaceFor ImmDB.MissingChunkFile {} = Namespace [] ["MissingChunkFile"]
    namespaceFor ImmDB.InvalidChunkFile {} = Namespace [] ["InvalidChunkFile"]
    namespaceFor ImmDB.MissingPrimaryIndex {} = Namespace [] ["MissingPrimaryIndex"]
    namespaceFor ImmDB.MissingSecondaryIndex {} = Namespace [] ["MissingSecondaryIndex"]
    namespaceFor ImmDB.InvalidPrimaryIndex {} = Namespace [] ["InvalidPrimaryIndex"]
    namespaceFor ImmDB.InvalidSecondaryIndex {} = Namespace [] ["InvalidSecondaryIndex"]
    namespaceFor ImmDB.RewritePrimaryIndex {} = Namespace [] ["RewritePrimaryIndex"]
    namespaceFor ImmDB.RewriteSecondaryIndex {} = Namespace [] ["RewriteSecondaryIndex"]

    severityFor  (Namespace _ ["StartedValidatingChunk"]) _ = Just Info
    severityFor  (Namespace _ ["ValidatedChunk"]) _ = Just Info
    severityFor  (Namespace _ ["MissingChunkFile"]) _ = Just Warning
    severityFor  (Namespace _ ["InvalidChunkFile"]) _ = Just Warning
    severityFor  (Namespace _ ["MissingPrimaryIndex"]) _ = Just Warning
    severityFor  (Namespace _ ["MissingSecondaryIndex"]) _ = Just Warning
    severityFor  (Namespace _ ["InvalidPrimaryIndex"]) _ = Just Warning
    severityFor  (Namespace _ ["InvalidSecondaryIndex"]) _ = Just Warning
    severityFor  (Namespace _ ["RewritePrimaryIndex"]) _ = Just Warning
    severityFor  (Namespace _ ["RewriteSecondaryIndex"]) _ = Just Warning
    severityFor _ _ = Nothing

    documentFor (Namespace _ ["StartedValidatingChunk"]) = Just
      ""
    documentFor (Namespace _ ["ValidatedChunk"]) = Just
      ""
    documentFor (Namespace _ ["MissingChunkFile"]) = Just
      ""
    documentFor (Namespace _ ["InvalidChunkFile"]) = Just
      ""
    documentFor (Namespace _ ["MissingPrimaryIndex"]) = Just
      ""
    documentFor (Namespace _ ["MissingSecondaryIndex"]) = Just
      ""
    documentFor (Namespace _ ["InvalidPrimaryIndex"]) = Just
      ""
    documentFor (Namespace _ ["InvalidSecondaryIndex"]) = Just
      ""
    documentFor (Namespace _ ["RewritePrimaryIndex"]) = Just
      ""
    documentFor (Namespace _ ["RewriteSecondaryIndex"]) = Just
      ""
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["StartedValidatingChunk"]
      , Namespace [] ["ValidatedChunk"]
      , Namespace [] ["MissingChunkFile"]
      , Namespace [] ["InvalidChunkFile"]
      , Namespace [] ["MissingPrimaryIndex"]
      , Namespace [] ["MissingSecondaryIndex"]
      , Namespace [] ["InvalidPrimaryIndex"]
      , Namespace [] ["InvalidSecondaryIndex"]
      , Namespace [] ["RewritePrimaryIndex"]
      , Namespace [] ["RewriteSecondaryIndex"]
      ]

--------------------------------------------------------------------------------
-- ImmDB.TraceCacheEvent
--------------------------------------------------------------------------------

instance LogFormatting ImmDB.TraceCacheEvent where
    forMachine _dtal (ImmDB.TraceCurrentChunkHit chunkNo nbPastChunksInCache) =
          mconcat [ "kind" .= String "TraceCurrentChunkHit"
                   , "chunkNo" .= String (renderChunkNo chunkNo)
                   , "noPastChunks" .= String (showT nbPastChunksInCache)
                   ]
    forMachine _dtal (ImmDB.TracePastChunkHit chunkNo nbPastChunksInCache) =
          mconcat [ "kind" .= String "TracePastChunkHit"
                   , "chunkNo" .= String (renderChunkNo chunkNo)
                   , "noPastChunks" .= String (showT nbPastChunksInCache)
                   ]
    forMachine _dtal (ImmDB.TracePastChunkMiss chunkNo nbPastChunksInCache) =
          mconcat [ "kind" .= String "TracePastChunkMiss"
                   , "chunkNo" .= String (renderChunkNo chunkNo)
                   , "noPastChunks" .= String (showT nbPastChunksInCache)
                   ]
    forMachine _dtal (ImmDB.TracePastChunkEvict chunkNo nbPastChunksInCache) =
          mconcat [ "kind" .= String "TracePastChunkEvict"
                   , "chunkNo" .= String (renderChunkNo chunkNo)
                   , "noPastChunks" .= String (showT nbPastChunksInCache)
                   ]
    forMachine _dtal (ImmDB.TracePastChunksExpired chunkNos nbPastChunksInCache) =
          mconcat [ "kind" .= String "TracePastChunksExpired"
                   , "chunkNos" .= String (Text.pack . show $ map renderChunkNo chunkNos)
                   , "noPastChunks" .= String (showT nbPastChunksInCache)
                   ]

instance MetaTrace ImmDB.TraceCacheEvent where
    namespaceFor ImmDB.TraceCurrentChunkHit {} = Namespace [] ["CurrentChunkHit"]
    namespaceFor ImmDB.TracePastChunkHit {} = Namespace [] ["PastChunkHit"]
    namespaceFor ImmDB.TracePastChunkMiss {} = Namespace [] ["PastChunkMiss"]
    namespaceFor ImmDB.TracePastChunkEvict {} = Namespace [] ["PastChunkEvict"]
    namespaceFor ImmDB.TracePastChunksExpired {} = Namespace [] ["PastChunkExpired"]

    severityFor  (Namespace _ ["CurrentChunkHit"]) _ = Just Debug
    severityFor  (Namespace _ ["PastChunkHit"]) _ = Just Debug
    severityFor  (Namespace _ ["PastChunkMiss"]) _ = Just Debug
    severityFor  (Namespace _ ["PastChunkEvict"]) _ = Just Debug
    severityFor  (Namespace _ ["PastChunkExpired"]) _ = Just Debug
    severityFor  _ _ = Nothing

    documentFor (Namespace _ ["CurrentChunkHit"]) = Just
      "Current chunk found in the cache."
    documentFor (Namespace _ ["PastChunkHit"]) = Just
      "Past chunk found in the cache"
    documentFor (Namespace _ ["PastChunkMiss"]) = Just
      "Past chunk was not found in the cache"
    documentFor (Namespace _ ["PastChunkEvict"]) = Just $ mconcat
      [ "The least recently used past chunk was evicted because the cache"
      , " was full."
      ]
    documentFor (Namespace _ ["PastChunkExpired"]) = Just
      ""
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["CurrentChunkHit"]
      , Namespace [] ["PastChunkHit"]
      , Namespace [] ["PastChunkMiss"]
      , Namespace [] ["PastChunkEvict"]
      , Namespace [] ["PastChunkExpired"]
      ]

--------------------------------------------------------------------------------
-- VolDb.TraceEvent
--------------------------------------------------------------------------------

instance StandardHash blk => LogFormatting (VolDB.TraceEvent blk) where
    forMachine _dtal VolDB.DBAlreadyClosed =
      mconcat [ "kind" .= String "DBAlreadyClosed"]
    forMachine _dtal (VolDB.BlockAlreadyHere blockId) =
      mconcat [ "kind" .= String "BlockAlreadyHere"
               , "blockId" .= String (showT blockId)
               ]
    forMachine _dtal (VolDB.Truncate pErr fsPath blockOffset) =
      mconcat [ "kind" .= String "Truncate"
               , "parserError" .= String (showT pErr)
               , "file" .= String (showT fsPath)
               , "blockOffset" .= String (showT blockOffset)
               ]
    forMachine _dtal (VolDB.InvalidFileNames fsPaths) =
      mconcat [ "kind" .= String "InvalidFileNames"
               , "files" .= String (Text.pack . show $ map show fsPaths)
              ]
    forMachine _dtal VolDB.DBClosed =
      mconcat [ "kind" .= String "DBClosed" ]

instance MetaTrace (VolDB.TraceEvent blk) where
    namespaceFor VolDB.DBAlreadyClosed {} = Namespace [] ["DBAlreadyClosed"]
    namespaceFor VolDB.BlockAlreadyHere {} = Namespace [] ["BlockAlreadyHere"]
    namespaceFor VolDB.Truncate {} = Namespace [] ["Truncate"]
    namespaceFor VolDB.InvalidFileNames {} = Namespace [] ["InvalidFileNames"]
    namespaceFor VolDB.DBClosed {} = Namespace [] ["DBClosed"]

    severityFor  (Namespace _ ["DBAlreadyClosed"]) _ = Just Debug
    severityFor  (Namespace _ ["BlockAlreadyHere"]) _ = Just Debug
    severityFor  (Namespace _ ["Truncate"]) _ = Just Debug
    severityFor  (Namespace _ ["InvalidFileNames"]) _ = Just Debug
    severityFor  (Namespace _ ["DBClosed"]) _ = Just Debug
    severityFor _ _ = Nothing

    documentFor  (Namespace _ ["DBAlreadyClosed"]) = Just
      "When closing the DB it was found it is closed already."
    documentFor  (Namespace _ ["BlockAlreadyHere"]) = Just
      "A block was found to be already in the DB."
    documentFor  (Namespace _ ["Truncate"]) =  Just
      "Truncates a file up to offset because of the error."
    documentFor  (Namespace _ ["InvalidFileNames"]) = Just
      "Reports a list of invalid file paths."
    documentFor  (Namespace _ ["DBClosed"]) = Just
      "Closing the volatile DB"
    documentFor _ = Nothing

    allNamespaces =
      [ Namespace [] ["DBAlreadyClosed"]
      , Namespace [] ["BlockAlreadyHere"]
      , Namespace [] ["Truncate"]
      , Namespace [] ["InvalidFileNames"]
      , Namespace [] ["DBClosed"]
      ]


--------------------------------------------------------------------------------
-- ChainInformation
--------------------------------------------------------------------------------

sevLedgerEvent :: LedgerEvent blk -> SeverityS
sevLedgerEvent (LedgerUpdate _)  = Notice
sevLedgerEvent (LedgerWarning _) = Critical

showProgressT :: Int -> Int -> Text
showProgressT chunkNo outOf =
  Text.pack (showFFloat
          (Just 2)
          (100 * fromIntegral chunkNo / fromIntegral outOf :: Float)
          mempty)

data ChainInformation = ChainInformation
  { slots                :: Word64
  , blocks               :: Word64
  , density              :: Rational
    -- ^ the actual number of blocks created over the maximum expected number
    -- of blocks that could be created over the span of the last @k@ blocks.
  , epoch                :: EpochNo
    -- ^ In which epoch is the tip of the current chain
  , slotInEpoch          :: Word64
    -- ^ Relative slot number of the tip of the current chain within the
    -- epoch.
  , blocksUncoupledDelta :: Int64
  , tipBlockHash :: Text
    -- ^ Hash of the last adopted block.
  , tipBlockParentHash :: Text
    -- ^ Hash of the parent block of the last adopted block.
  , tipBlockIssuerVerificationKeyHash :: BlockIssuerVerificationKeyHash
    -- ^ Hash of the last adopted block issuer's verification key.
  }


chainInformation
  :: forall blk. HasHeader (Header blk)
  => HasIssuer blk
  => ConvertRawHash blk
  => ChainDB.SelectionChangedInfo blk
  -> AF.AnchoredFragment (Header blk)
  -> AF.AnchoredFragment (Header blk) -- ^ New fragment.
  -> Int64
  -> ChainInformation
chainInformation selChangedInfo oldFrag frag blocksUncoupledDelta = ChainInformation
    { slots = unSlotNo $ fromWithOrigin 0 (AF.headSlot frag)
    , blocks = unBlockNo $ fromWithOrigin (BlockNo 1) (AF.headBlockNo frag)
    , density = fragmentChainDensity frag
    , epoch = ChainDB.newTipEpoch selChangedInfo
    , slotInEpoch = ChainDB.newTipSlotInEpoch selChangedInfo
    , blocksUncoupledDelta = blocksUncoupledDelta
    , tipBlockHash = renderHeaderHash (Proxy @blk) $ realPointHash (ChainDB.newTipPoint selChangedInfo)
    , tipBlockParentHash = renderChainHash (Text.decodeLatin1 . B16.encode . toRawHash (Proxy @blk)) $ AF.headHash oldFrag
    , tipBlockIssuerVerificationKeyHash = tipIssuerVkHash
    }
  where
    tipIssuerVkHash :: BlockIssuerVerificationKeyHash
    tipIssuerVkHash = either (const NoBlockIssuer) getIssuerVerificationKeyHash (AF.head frag)

fragmentChainDensity ::
  HasHeader (Header blk)
  => AF.AnchoredFragment (Header blk) -> Rational
fragmentChainDensity frag = calcDensity blockD slotD
  where
    calcDensity :: Word64 -> Word64 -> Rational
    calcDensity bl sl
      | sl > 0 = toRational bl / toRational sl
      | otherwise = 0
    slotN  = unSlotNo $ fromWithOrigin 0 (AF.headSlot frag)
    -- Slot of the tip - slot @k@ blocks back. Use 0 as the slot for genesis
    -- includes EBBs
    slotD   = slotN
            - unSlotNo (fromWithOrigin 0 (AF.lastSlot frag))
    -- Block numbers start at 1. We ignore the genesis EBB, which has block number 0.
    blockD = blockN - firstBlock
    blockN = unBlockNo $ fromWithOrigin (BlockNo 1) (AF.headBlockNo frag)
    firstBlock = case unBlockNo . blockNo <$> AF.last frag of
      -- Empty fragment, no blocks. We have that @blocks = 1 - 1 = 0@
      Left _  -> 1
      -- The oldest block is the genesis EBB with block number 0,
      -- don't let it contribute to the number of blocks
      Right 0 -> 1
      Right b -> b

--------------------------------------------------------------------------------
-- Other orophans
--------------------------------------------------------------------------------

instance LogFormatting LedgerDB.DiskSnapshot where
  forMachine DDetailed snap =
    mconcat [ "kind" .= String "snapshot"
             , "snapshot" .= String (Text.pack $ show snap) ]
  forMachine _ _snap = mconcat [ "kind" .= String "snapshot" ]


instance ( StandardHash blk
         , LogFormatting (ValidationErr (BlockProtocol blk))
         , LogFormatting (OtherHeaderEnvelopeError blk)
         )
      => LogFormatting (HeaderError blk) where
  forMachine dtal (HeaderProtocolError err) =
    mconcat
      [ "kind" .= String "HeaderProtocolError"
      , "error" .= forMachine dtal err
      ]
  forMachine dtal (HeaderEnvelopeError err) =
    mconcat
      [ "kind" .= String "HeaderEnvelopeError"
      , "error" .= forMachine dtal err
      ]

instance ( StandardHash blk
         , LogFormatting (OtherHeaderEnvelopeError blk)
         )
      => LogFormatting (HeaderEnvelopeError blk) where
  forMachine _dtal (UnexpectedBlockNo expect act) =
    mconcat
      [ "kind" .= String "UnexpectedBlockNo"
      , "expected" .= condense expect
      , "actual" .= condense act
      ]
  forMachine _dtal (UnexpectedSlotNo expect act) =
    mconcat
      [ "kind" .= String "UnexpectedSlotNo"
      , "expected" .= condense expect
      , "actual" .= condense act
      ]
  forMachine _dtal (UnexpectedPrevHash expect act) =
    mconcat
      [ "kind" .= String "UnexpectedPrevHash"
      , "expected" .= String (Text.pack $ show expect)
      , "actual" .= String (Text.pack $ show act)
      ]

  forMachine _dtal (CheckpointMismatch blockNumber hdrHashExpected hdrHashActual) =
    mconcat
      [ "kind" .= String "CheckpointMismatch"
      , "blockNo" .= String (Text.pack $ show blockNumber)
      , "expected" .= String (Text.pack $ show hdrHashExpected)
      , "actual" .= String (Text.pack $ show hdrHashActual)
      ]

  forMachine dtal (OtherHeaderEnvelopeError err) =
    forMachine dtal err


instance (   LogFormatting (LedgerError blk)
           , LogFormatting (HeaderError blk))
        => LogFormatting (ExtValidationError blk) where
    forMachine dtal (ExtValidationErrorLedger err) = forMachine dtal err
    forMachine dtal (ExtValidationErrorHeader err) = forMachine dtal err

    forHuman (ExtValidationErrorLedger err) =  forHuman err
    forHuman (ExtValidationErrorHeader err) =  forHuman err

    asMetrics (ExtValidationErrorLedger err) =  asMetrics err
    asMetrics (ExtValidationErrorHeader err) =  asMetrics err

instance (Show (PBFT.PBftVerKeyHash c))
      => LogFormatting (PBFT.PBftValidationErr c) where
  forMachine _dtal (PBFT.PBftInvalidSignature text) =
    mconcat
      [ "kind" .= String "PBftInvalidSignature"
      , "error" .= String text
      ]
  forMachine _dtal (PBFT.PBftNotGenesisDelegate vkhash _ledgerView) =
    mconcat
      [ "kind" .= String "PBftNotGenesisDelegate"
      , "vk" .= String (Text.pack $ show vkhash)
      ]
  forMachine _dtal (PBFT.PBftExceededSignThreshold vkhash numForged) =
    mconcat
      [ "kind" .= String "PBftExceededSignThreshold"
      , "vk" .= String (Text.pack $ show vkhash)
      , "numForged" .= String (Text.pack (show numForged))
      ]
  forMachine _dtal PBFT.PBftInvalidSlot =
    mconcat
      [ "kind" .= String "PBftInvalidSlot"
      ]

instance (Show (PBFT.PBftVerKeyHash c))
      => LogFormatting (PBFT.PBftCannotForge c) where
  forMachine _dtal (PBFT.PBftCannotForgeInvalidDelegation vkhash) =
    mconcat
      [ "kind" .= String "PBftCannotForgeInvalidDelegation"
      , "vk" .= String (Text.pack $ show vkhash)
      ]
  forMachine _dtal (PBFT.PBftCannotForgeThresholdExceeded numForged) =
    mconcat
      [ "kind" .= String "PBftCannotForgeThresholdExceeded"
      , "numForged" .= numForged
      ]
